Sub AfficheTotalFichiers()
Debug.Print NombreFichiers("C:\Mes Documents\", "docx", "xlsx")
End Sub
'Fonction qui compte le nombre de fichiers dans un répertoire
Function NombreFichiers(Chemin As String, ParamArray LesExtensions() As Variant) As Long
Dim Fichier As String
Dim Extension As Variant
Dim Compteur As Long
For Each Extension In LesExtensions
Fichier = Dir(Chemin & "*." & Extension)
Do Until Fichier = ""
Compteur = Compteur + 1
Fichier = Dir
Loop
Next
NombreFichiers = Compteur
End Function
Codes utiles en VBA pour Excel, Word et Access
vendredi 6 janvier 2017
Compter le nombre de fichiers dans un répertoire avec une (ou des) extensions passées en paramètres
Dans un module en VBA, copier/coller le code suivant :
mardi 31 mai 2016
Parcourir la liste des control sur un formulaire (CheckBox, TextBox, ComboBox...)
A placer dans un UserForm. Cela fonctionne sur n'importe quel type de control.
Dim objControl As Control
'variante 1
For Each objControl In Me.Controls
If TypeOf objControl Is MSForms.TextBox Then 'modifier ici le type si nécessaire
MsgBox objControl.Name
End If
Next
'variante 2
For Each objControl In Me.Controls
If TypeName(objControl) = "TextBox" Then 'modifier ici le type si nécessaire
MsgBox objControl.Name
End If
Next
mercredi 11 mai 2016
Vérification de la saisie dans une TextBox
A placer sur l'événement KeyPress d'une TextBox
Gestion de certaines valeurs autorisées :
Gestion de la décimale virgule / point
Gestion de certaines valeurs autorisées :
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'n'accepte que les chiffres et le /
If InStr("1234567890/", Chr(KeyAscii)) = 0 Then KeyAscii = 0: Beep
End Sub
Gestion de la décimale virgule / point
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 44, 46 ' que l'on frappe une virgule ou un point
If InStr(TextBox1.Text, ",") Then 'si déjà une virgule présent
KeyAscii = 0 'on ne permet pas deux virgules
Else ' sinon
KeyAscii = 44 'on force la une virgule
End If
Case 48 To 57
'on laisse passer car ce sont des chiffres
Case Else
KeyAscii = 0 'on ne laisse pas passer
End Select
End Sub
mardi 8 mars 2016
Manipuler Word en Vba depuis Excel par exemple
'**************************************************************************************
' Manipuler Word en VBA
' ajouter la référence à Microsoft Word xx.x library au projet
' (Menu Projet >> Références...)
'**************************************************************************************
Sub GestionWord ()
Dim AppWord As Word.Application On Error Resume Next
' Cherche une instance de Word si elle existe
Set AppWord = GetObject(, "Word.Application")
If Err <> 0 Then
' Si GetObject échoue, utiliser CreateObject pour créer une instance de Word
Set AppWord = CreateObject("Word.Application")
End If
' ajoute un nouveau document
AppWord.Documents.Add
' insère du texte au point d'insertion AppWord.Selection.TypeText Text:="Liste des Clients"
' sauter une ligne
AppWord.Selection.TypeParagraph
' copie le contenu de A1 dans le document Word
AppWord.Selection.TypeText Text:="" & Range("A1").Value
' enregistre les modifications
AppWord.Documents.Save
' rend Word visible
AppWord.Visible = True
' Quitte Word
AppWord.Quit
' Vide l'objet en mémoire
Set AppWord = Nothing
End Sub
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 :
Dans un autre module, faire appel à ces fonctions, par exemple de la manière suivante :
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)
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
Inscription à :
Articles (Atom)