lundi 21 décembre 2015

Vérifier par VBA si un lecteur ou un dossier (répertoire) ou un fichier existe

Cocher la bibliothèque  Microsoft Scripting Runtime dans Outils / Références

Dans un module en VBA, copier/coller le code suivant :

Public oFSO As Scripting.FileSystemObject
Public oFichier As Scripting.File 'pour gérer un fichier
Public oTxt As Scripting.TextStream 'pour gérer le contenu

Function VerifLecteur(Lecteur As String) As Boolean
    'permet de tester l'existence d'un lecteur
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.DriveExists(Lecteur) = True Then
        VerifLecteur = True
    Else
        VerifLecteur = False
    End If
End Function

Function VerifRep(Repertoire As String) As Boolean
    'permet de tester l'existence d'un répertoire
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.FolderExists(Repertoire) = True Then
        VerifRep = True
    Else
        VerifRep = False
    End If
End Function

Function VerifFich(Fichier As String) As Boolean
    'permet de tester l'existence d'un fichier
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.FileExists(Fichier) = True Then
        VerifFich = True
    Else
        VerifFich = False
    End If
End Function


Dans un autre module, faire appel à ces fonctions, par exemple de la manière suivante :

Sub Test()
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
 
    'test sur un lecteur
    If VerifLecteur("P") = True Then
        MsgBox "le lecteur existe"
    Else
        MsgBox "le lecteur n'existe pas"
    End If

    'test sur un dossier (répertoire)
    If VerifRep("C:\Android") = True Then
        MsgBox "le repertoire existe"
    Else
        MsgBox "le repertoire n'existe pas"
    End If
 
    'test sur un fichier
    If VerifFich("C:\Windows\win.ini") = True Then
        MsgBox "le fichier existe"
    Else
        MsgBox "le fichier n'existe pas"
    End If


End Sub

lundi 3 août 2015

Intercepter touche Entrée dans un TextBox

Il suffit d'utiliser l'événement "KeyDown" et de vérifier si le code renvoyé correspond à la touche ENTREE

Private Sub TexBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        'mon code
    End If
End Sub

Selectionner le contenu d'un TextBox qui reçoit le focus

Pour sélectionner le contenu d'une zone de texte (TextBox), utiliser les propriétés SelStart et SelLength du composant.
Créer un TextBox sur un UserForm et placer le code ci-dessous dans une procédure qui donne le focus au TextBox :
(par exemple sur l'évènement Activate du UserForm)


Private Sub UserForm_Activate()
    Me.TextBox1.Value = "Valeur par défaut" 'pour avoir un contenu
    Me.TextBox1.SelStart = 0 'se positionne avant le premier caractère
    Me.TextBox1.SelLength = Len(Me.TextBox1.Text) 'indique la longueur de la sélection
    Me.TextBox1.SetFocus 'donne le focus
End Sub

vendredi 27 février 2015

Vérifier par VBA si un classeur est déjà ouvert sur le même PC ou en réseau

Placer ce code dans un module de l'éditeur VBA :


Sub TestSiClasseurOuvert()
    If Not FichierDejaOuvert("C:\Planning.xlsx") Then 'le chemin doit être renseigné
        MsgBox "Classeur pas ouvert"
    Else
        MsgBox "Classeur ouvert"
    End If
End Sub

Public Function FichierDejaOuvert(MonFichier As String) As Boolean  'Vérifie si un classeur est déjà ouvert
    On Error Resume Next
    Open MonFichier For Binary Access Read Lock Read As #1
    Close #1
    FichierDejaOuvert = IIf(Err.Number > 0, True, False)
    On Error GoTo 0
End Function