
' Declare variables pour les bulles du compagnon.
Public balloon1 As Balloon
Public balloon2 As Balloon
Public balloon3 As Balloon
' Il est possible d'utilisé un tableau en place de
'déclarations multiple, j'ai choisi l'option multiple pour
'que le code soit plus explicite.
'Public BalloonMultipl(3) as balloon
'
Public Titre As String
Public Message As String
Sub ouvreMessage()
' Declare variables.
Dim AssistantName As String
Dim IsVisible As Boolean
Dim Result As Byte
' Met les erreur clear
On Error Resume Next
Err.Clear
' mémorise le nom courant de l'assistant.
AssistantName = Assistant.Name
' Si l'assistant n'est pas visible, le met visible
If Assistant.Visible = False Then
Assistant.Visible = True
IsVisible = False
Else
IsVisible = True
End If
' crée un assistant balloon.
Set balloon2 = Assistant.NewBalloon
With balloon2
' Met titre et texte des questions.
.Heading = Titre
.Text = Message
' Sets le type de propriétés de l'assistant.
.BalloonType = msoBalloonTypeButtons
' le mode modal, par défaut.
.Mode = msoModeModal
'assigne Annulé au bouton, OK est par défaut.
.Button = msoButtonSetOK
End With
' Attend une sélection
Do
' Sélection faite
Result = balloon2.Show
' Si le bouton est sélectionné, termine la macro.
If Err <> 0 Then
If IsVisible = False Then
Assistant.Visible = False
End If
End
End If
Loop
End Sub
Sub AfficheInfoAccesFichier(specfichier)
'Il faut que le classeur soit déjà sur le disque dur.
'----------------------------------------------------
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(specfichier)
s = UCase(specfichier) & vbCrLf
s = s & "Créé le : " & f.DateCreated & vbCrLf
s = s & "Dernier accès le : " & f.DateLastAccessed & vbCrLf
s = s & "Dernière modification le : " & f.DateLastModified & vbCrLf
s = s & "Taille " & f.Size & " bytes." & vbCrLf
s = s & "Drive " & f.Drive & vbCrLf
s = s & "Répertoir " & f.ParentFolder
Titre = "Infos sur le fichier : " & specfichier
Message = s
ouvreMessage
End Sub
Private Sub Worksheet_Activate()
Range("B5").Value = "Afficher les données du fichier"
With ActiveSheet.Range("B5").Font
.Name = "Arial"
.Size = 16
.ColorIndex = 5
.Bold = True
End With
Columns("B").ColumnWidth = 48
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a$, b$
a$ = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
b$ = ActiveWorkbook.Name
If ActiveCell.Address = "$B$5" Then
AfficheInfoAccesFichier (ActiveWorkbook.Name)
End If
End SubRésultats pour VBA : Tout connaitre sur le fichier du classeur
Résultats pour VBA : Tout connaitre sur le fichier du classeur
Résultats pour VBA : Tout connaitre sur le fichier du classeur
Résultats pour VBA : Tout connaitre sur le fichier du classeur
Résultats pour VBA : Tout connaitre sur le fichier du classeur