Option Explicit
'
Sub CreerDossier()
Dim T()
T = Worksheets("Réclamations").[B6:E6].Value
If CheminCourantAssumé("Q:\CLI11PTE\AA-RECLAMATION GAZ\Historique des Réclamations\" _
& T(1, 1) & " " & T(1, 2) & " " & T(1, 3) & " " & T(1, 4)) Then
'Faire apparaite bulle
ActiveSheet.Shapes("MonBouton1").Visible = True
Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage1"
End If
End Sub
'
'Effacement de la bulle
Sub EffacerMessage1()
ActiveSheet.Shapes("MonBouton1").Visible = False
'Call Enregistrer_Classeur
'Sheets("Echéancier").Range("K4").Value = Format(Now, "dddd dd mmmm yyyy / h:mm")
End Sub
'
Function CheminCourantAssumé(ByVal Chm As String) As Boolean
Dim TSpl() As String, P&
TSpl = Split(Chm, "\")
On Error Resume Next
ChDrive TSpl(0): If Err Then MsgBox "Lecteur """ & Left$(TSpl(0), 1) & """ inconnu.", _
vbCritical, "CheminCourantAssumé": Exit Function
ChDir TSpl(0) & "\"
For P = 1 To UBound(TSpl)
If TSpl(P) <> "" Then
ChDir TSpl(P)
If Err Then
Err.Clear: MkDir TSpl(P): If Err Then MsgBox "Impossible de créer un dossier """ _
& TSpl(P) & """ sur :" & vbLf & CurDir, vbCritical, "CheminCourantAssumé": Exit Function
ChDir TSpl(P): End If
End If: Next P
CheminCourantAssumé = True
End Function