tag:blogger.com,1999:blog-81332487949738199912024-02-20T00:41:44.781-08:00Codes utiles en VBA pour Excel, Word et AccessDavidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.comBlogger16125tag:blogger.com,1999:blog-8133248794973819991.post-58860514828320034152017-01-06T03:17:00.002-08:002017-01-06T04:28:08.869-08:00Compter le nombre de fichiers dans un répertoire avec une (ou des) extensions passées en paramètresDans un module en VBA, copier/coller le code suivant :<br />
<br />
<code>
Sub AfficheTotalFichiers()<br />
Debug.Print NombreFichiers("C:\Mes Documents\", "docx", "xlsx")<br />
End Sub<br />
<br />
<br />
'Fonction qui compte le nombre de fichiers dans un répertoire<br />
Function NombreFichiers(Chemin As String, ParamArray LesExtensions() As Variant) As Long<br />
Dim Fichier As String<br />
Dim Extension As Variant<br />
Dim Compteur As Long<br />
<br />
For Each Extension In LesExtensions<br />
Fichier = Dir(Chemin & "*." & Extension)<br />
Do Until Fichier = ""<br />
Compteur = Compteur + 1<br />
Fichier = Dir<br />
Loop<br />
Next<br />
<br />
NombreFichiers = Compteur<br />
End Function
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-13932930328847342932016-05-31T21:04:00.003-07:002016-05-31T21:05:40.810-07:00Parcourir la liste des control sur un formulaire (CheckBox, TextBox, ComboBox...)<br />
A placer dans un UserForm. Cela fonctionne sur n'importe quel type de control.<br />
<br />
<code>
Dim objControl As Control<br />
<br />
'variante 1<br />
For Each objControl In Me.Controls<br />
If TypeOf objControl Is MSForms.TextBox Then 'modifier ici le type si nécessaire<br />
MsgBox objControl.Name<br />
End If<br />
Next<br />
<br />
'variante 2<br />
For Each objControl In Me.Controls<br />
If TypeName(objControl) = "TextBox" Then 'modifier ici le type si nécessaire<br />
MsgBox objControl.Name<br />
End If<br />
Next<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-6929583886844909582016-05-11T06:30:00.000-07:002016-05-31T21:35:12.711-07:00Vérification de la saisie dans une TextBoxA placer sur l'événement KeyPress d'une TextBox<br />
<br />
Gestion de certaines valeurs autorisées :<br />
<br />
<code>
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)<br />
'n'accepte que les chiffres et le /<br />
If InStr("1234567890/", Chr(KeyAscii)) = 0 Then KeyAscii = 0: Beep<br />
End Sub<br />
</code>
<br />
<br />
<br />
Gestion de la décimale virgule / point<br />
<br />
<code>
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)<br />
Select Case KeyAscii<br />
Case 44, 46 ' que l'on frappe une virgule ou un point<br />
If InStr(TextBox1.Text, ",") Then 'si déjà une virgule présent<br />
KeyAscii = 0 'on ne permet pas deux virgules<br />
Else ' sinon<br />
KeyAscii = 44 'on force la une virgule<br />
End If<br />
Case 48 To 57<br />
'on laisse passer car ce sont des chiffres<br />
Case Else<br />
KeyAscii = 0 'on ne laisse pas passer<br />
End Select<br />
End Sub<br />
</code>
Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com1tag:blogger.com,1999:blog-8133248794973819991.post-46948673913951402812016-03-08T15:00:00.000-08:002016-05-23T06:26:09.018-07:00Manipuler Word en Vba depuis Excel par exemple<code>
'**************************************************************************************<br />' Manipuler Word en VBA<br />' ajouter la référence à Microsoft Word xx.x library au projet </code><br />
<code>' (Menu Projet >> Références...)<br />'**************************************************************************************<br />
</code><br />
<code>Sub GestionWord ()</code><br />
<code><br /> </code><span style="font-family: monospace;">Dim </span><span style="font-family: monospace;">AppWord </span><span style="font-family: monospace;">As Word.Application</span><br />
<span style="font-family: monospace;"><br /></span>
<code> On Error Resume Next<br />
<br />
' Cherche une instance de Word si elle existe<br />
Set AppWord = GetObject(, "Word.Application")<br />
<br />
If Err <> 0 Then<br />
' Si GetObject échoue, utiliser CreateObject pour créer une instance de Word<br />
Set AppWord = CreateObject("Word.Application")<br />
End If<br />
<br />
' ajoute un nouveau document<br /> AppWord.Documents.Add<br />
<br /> </code><span style="font-family: monospace;">' insère du texte au point d'insertion</span><br />
<code> AppWord.Selection.TypeText Text:="Liste des Clients"<br />
<br /> ' sauter une ligne<br /> AppWord.Selection.TypeParagraph<br /><br /> ' copie le contenu de A1 dans le document Word<br /> AppWord.Selection.TypeText Text:="" & Range("A1").Value<br />
<br />
' enregistre les modifications<br /> AppWord.Documents.Save<br />
<br />
' rend Word visible<br /> AppWord.Visible = True<br />
<br />
<code>
' Quitte Word<br /> AppWord.Quit<br />
<br />
' Vide l'objet en mémoire<br />
Set AppWord = Nothing</code><br />
<br />
End Sub <br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-59096381345904267162015-12-21T06:41:00.001-08:002015-12-21T06:41:49.080-08:00Vérifier par VBA si un lecteur ou un dossier (répertoire) ou un fichier existeCocher la bibliothèque Microsoft Scripting Runtime dans Outils / Références<br />
<div>
<br /></div>
Dans un module en VBA, copier/coller le code suivant :<br />
<br />
<code>
Public oFSO As Scripting.FileSystemObject<br />
Public oFichier As Scripting.File 'pour gérer un fichier<br />
Public oTxt As Scripting.TextStream 'pour gérer le contenu<br />
<br />
Function VerifLecteur(Lecteur As String) As Boolean<br />
'permet de tester l'existence d'un lecteur<br />
'initialisation de l'objet oFSO<br />
Set oFSO = New Scripting.FileSystemObject<br />
'test si le lecteur existe<br />
If oFSO.DriveExists(Lecteur) = True Then<br />
VerifLecteur = True<br />
Else<br />
VerifLecteur = False<br />
End If<br />
End Function<br />
<br />
Function VerifRep(Repertoire As String) As Boolean<br />
'permet de tester l'existence d'un répertoire<br />
'initialisation de l'objet oFSO<br />
Set oFSO = New Scripting.FileSystemObject<br />
'test si le lecteur existe<br />
If oFSO.FolderExists(Repertoire) = True Then<br />
VerifRep = True<br />
Else<br />
VerifRep = False<br />
End If<br />
End Function<br />
<br />
Function VerifFich(Fichier As String) As Boolean<br />
'permet de tester l'existence d'un fichier<br />
'initialisation de l'objet oFSO<br />
Set oFSO = New Scripting.FileSystemObject<br />
'test si le lecteur existe<br />
If oFSO.FileExists(Fichier) = True Then<br />
VerifFich = True<br />
Else<br />
VerifFich = False<br />
End If<br />
End Function<br />
</code>
<br />
<br />
Dans un autre module, faire appel à ces fonctions, par exemple de la manière suivante :<br />
<br />
<code>
Sub Test()<br />
'initialisation de l'objet oFSO<br />
Set oFSO = New Scripting.FileSystemObject<br />
<br />
'test sur un lecteur<br />
If VerifLecteur("P") = True Then<br />
MsgBox "le lecteur existe"<br />
Else<br />
MsgBox "le lecteur n'existe pas"<br />
End If<br />
<br />
'test sur un dossier (répertoire)<br />
If VerifRep("C:\Android") = True Then<br />
MsgBox "le repertoire existe"<br />
Else<br />
MsgBox "le repertoire n'existe pas"<br />
End If<br />
<br />
'test sur un fichier<br />
If VerifFich("C:\Windows\win.ini") = True Then<br />
MsgBox "le fichier existe"<br />
Else<br />
MsgBox "le fichier n'existe pas"<br />
End If<br />
<br />
<br />
End Sub<br />
</code>
Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-46617944799171057582015-08-03T04:39:00.003-07:002015-08-03T04:40:03.804-07:00Intercepter touche Entrée dans un TextBoxIl suffit d'utiliser l'événement "KeyDown" et de vérifier si le code renvoyé correspond à la touche ENTREE
<br />
<br />
<code>
Private Sub TexBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)<br />
If KeyCode = 13 Then<br />
'mon code<br />
End If<br />
End Sub<br />
<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-57748762611036500532015-08-03T00:34:00.002-07:002015-08-03T00:37:36.803-07:00Selectionner le contenu d'un TextBox qui reçoit le focusPour sélectionner le contenu d'une zone de texte (TextBox), utiliser les propriétés SelStart et SelLength du composant.<br />
Créer un TextBox sur un UserForm et placer le code ci-dessous dans une procédure qui donne le focus au TextBox :<br />
(par exemple sur l'évènement Activate du UserForm)<br />
<br />
<br />
<code>
Private Sub UserForm_Activate()<br />
Me.TextBox1.Value = "Valeur par défaut" 'pour avoir un contenu<br />
Me.TextBox1.SelStart = 0 'se positionne avant le premier caractère<br />
Me.TextBox1.SelLength = Len(Me.TextBox1.Text) 'indique la longueur de la sélection<br />
Me.TextBox1.SetFocus 'donne le focus<br />
End Sub<br />
<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-32802088017718850552015-02-27T05:47:00.002-08:002015-02-27T05:57:02.432-08:00Vérifier par VBA si un classeur est déjà ouvert sur le même PC ou en réseauPlacer ce code dans un module de l'éditeur VBA :<br />
<br />
<br />
<code>
Sub TestSiClasseurOuvert()<br />
If Not FichierDejaOuvert("C:\Planning.xlsx") Then 'le chemin doit être renseigné<br />
MsgBox "Classeur pas ouvert"<br />
Else<br />
MsgBox "Classeur ouvert"<br />
End If<br />
End Sub<br />
<br />
Public Function FichierDejaOuvert(MonFichier As String) As Boolean 'Vérifie si un classeur est déjà ouvert<br />
On Error Resume Next<br />
Open MonFichier For Binary Access Read Lock Read As #1<br />
Close #1<br /> FichierDejaOuvert = IIf(Err.Number > 0, True, False)<br />
On Error GoTo 0<br />
End Function<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-9265732705504077172014-09-23T06:11:00.000-07:002014-09-23T06:11:01.235-07:00Modifier par code le nom VBA d'une Feuille de Calcul (pas le nom de l'onglet)Placer ce code dans une procédure ou une fonction dans l'éditeur VBA :<br />
<br />
<code>NomActuelVba= ActiveSheet.<b>CodeName</b><br />ActiveWorkbook.VBProject.VBComponents(NomActuelVba).Name = "NomFeuilleCoteVBA"
</code>
<br />
<br />
A ne pas confondre avec ce code qui modifie le nom de l'onglet coté Excel :<br />
<br />
<code>ActiveSheet.<b>Name </b>= "NomFeuille"
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-38148060096831596872013-12-17T05:16:00.000-08:002013-12-17T05:22:06.388-08:00Nombre de jours ou mois ou années entre 2 datesVoici 3 fonctions permettant de retrouver le nombre de jours ou de mois ou d'années entre 2 dates.<br />
(la date 1 doit être inférieure à la date 2)
<br />
<br />
1) Placer le code suivant dans un module :
<br />
<code>
<br />
'Nombre d'années<br />
Function DifDateAnnee(pDate1 As Date, pDate2 As Date) As Long<br />
DifDateAnnee = DateDiff("yyyy", pDate1, pDate2)<br />
End Function
<br />
<br />
'Nombre de mois<br />
Function DifDateMois(pDate1 As Date, pDate2 As Date) As Long<br />
DifDateMois = DateDiff("m", pDate1, pDate2)<br />
End Function
<br />
<br />
'Nombre de jours<br />
Function DifDateJour(pDate1 As Date, pDate2 As Date) As Long<br />
DifDateJour = DateDiff("d", pDate1, pDate2)<br />
End Function
</code>
<br />
<br />
2) Puis faire appel à cette fonction dans une procédure quelconque :<br />
<br />
<br />
<span style="font-family: monospace;">Sub DifferenceEntre2Dates()</span><br />
<span style="font-family: monospace;"> </span><br />
<span style="font-family: monospace;"> Dim Date1 As Date, Date2 As Date</span><br />
<span style="font-family: monospace;"> Date1 = "01/12/2013"</span><br />
<span style="font-family: monospace;"> Date2 = "15/04/2016"</span><br />
<span style="font-family: monospace;"> </span><br />
<span style="font-family: monospace;"> MsgBox "Nombre d'années entre les 2 dates : " & DifDateAnnee(Date1, Date2)</span><br />
<span style="font-family: monospace;"> MsgBox "Nombre de mois entre les 2 dates : " & DifDateMois(Date1, Date2)</span><br />
<span style="font-family: monospace;"> MsgBox "Nombre de jours entre les 2 dates : " & DifDateJour(Date1, Date2)</span><br />
<span style="font-family: monospace;"><br /></span>
<span style="font-family: monospace;">End Sub</span>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-32420506679203285802013-12-17T05:01:00.004-08:002013-12-17T05:04:18.986-08:00Trouver le numéro de la semaine à partir d'une dateVoici une fonction permettant de déduire le numéro de la semaine dans une année.<br />
Attention à toujours vérifier pour une date qui s'approche du 31/12 (qui appartient donc à une semaine à cheval sur l'année suivante) : dans ce cas, cette fonction renverra la valeur 1 (pour la semaine 1 de l'année suivante).
<br />
<br />
1) Placer le code suivant dans un module :
<br />
<code>Function Semaine(UneDate As Date) As Integer<br />
Semaine = Format(UneDate, "ww", , vbFirstFourDays)<br />
End Function
</code>
<br />
<br />
2) Appeler la fonction de cette manière :
<br />
<code>Sub NumeroDeSemaine ()<br />
MsgBox Semaine(#10/31/2013#)<br />
End Function
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com1tag:blogger.com,1999:blog-8133248794973819991.post-61509157144603478422013-08-27T22:10:00.001-07:002014-01-28T03:39:54.816-08:00Créer un bouton "Parcourir" pour sélectionner un Répertoire (Excel, Word, Access)1) Créer un bouton sur un Userform, puis gérer l'événement Click côté code en intégrant le code ci-dessous<br />
<br />
<code>
Private Sub CommandButton1_Click()<br />
<br />
Dim Repertoire As FileDialog<br />
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)<br />
Repertoire.Show<br />
If Repertoire.SelectedItems.Count > 0 Then<br />
MsgBox Repertoire.SelectedItems(1)<br />
Else<br />
MsgBox "Aucun Répertoire Sélectionné"<br />
End If<br />
<br />
End Sub
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com2tag:blogger.com,1999:blog-8133248794973819991.post-9394879026434939982013-08-05T07:03:00.001-07:002013-08-27T22:10:59.405-07:00Trouver la lettre d'une colonne à partir de son numéro (Excel)Le plus simple est de créer une fonction qui renverra à la demande la lettre :<br />
<br />
1) Placer le code suivant dans un module : <br />
<br />
<code>
'Fonction qui renvoie la lettre à partir du numéro d'une colonne<br />
Public Function lettre_colonne(colonne As Integer)<br />
lettre_colonne = Split(Cells(1, colonne).Address, "$")(1)<br />
End Function<br />
</code><br />
<br />
2) Puis faire appel à cette fonction dans une procédure quelconque :<br />
<code><br />Recup = lettre_colonne(5) 'renvoie la lettre E<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-20989781009472278522013-08-05T06:37:00.006-07:002013-08-27T22:11:15.156-07:00Comment vérifier si un fichier existe ou non (Excel, Word, Access)Le plus simple est de créer une fonction qui renverra Vrai ou Faux en fonction du résultat<br />
<br />
1) Placer le code suivant dans un module :
<br />
<br />
<code>
'Fonction qui vérifie si un fichier existe<br />
Public Function FichierExiste(Chemin As String) As Boolean<br />
If Dir(Chemin) = "" Then<br /> FichierExiste = False<br />
Else<br /> FichierExiste = True<br />
End If<br />
End Function</code><br />
<br />
2) Puis faire appel à cette fonction dans une procédure quelconque :<br />
<br />
<code>
If FichierExiste("C:\Dossier\toto.xlsx") = True then </code><br />
<code>
'procédure si le fichier existe<br />
Else<br />
'procédure si le fichier n'existe pas<br />
End If</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-56647506685342224092013-08-05T06:28:00.001-07:002013-08-27T22:11:27.499-07:00Trouver la dernière cellule avec un contenu dans une feuille ExcelPour ajouter une ligne (ou une colonne) à une liste gérée à partir de Vba, il est souvent nécessaire de trouver la référence de la dernière cellule pour ensuite insérer la nouvelle donnée.<br />
<br />
Pour se faire, il est pratique d'utiliser la fonction Vba "End" permettant d'obtenir rapidement cette information.<br />
<br />
<b>Important : cette fonction ne doit s’utiliser que dans des colonnes ou lignes ininterrompues.</b><br />
<br />
A noter, qu'il est possible de rechercher cette info dans chaque direction :<br />
<br />
<ul>
<li>vers la droite : xlRight</li>
<li>vers la gauche : xlLeft</li>
<li>vers le bas : xlDown</li>
<li>vers le haut : xlUp</li>
</ul>
<br />
Exemples :<br />
<br />
<code>
Recup = Range("A50000").End(xlUp).Address 'obtient la référence de la cellule juste après la dernière cellule contenant une donnée en partant du bas dans la colonne A<br />
<br />
Recup = Range("A2").End(xlDown).Address 'obtient la référence la dernière cellule contenant une donnée en partant du haut dans la colonne A<br />
<br />
Recup = Range("A2").End(xlDown).Row 'obtient la dernière ligne contenant une donnée en partant du haut dans la colonne A<br />
<br />
Recup = Range("A2").End(xlRight).Column 'obtient le numéro de la dernière colonne contenant une donnée vers la droite dans la ligne 2<br />
</code>
<br />
<code><br /></code>
Pour trouver la lettre qui correspond à cette colonne voir cet article : <a href="http://codes-vba.blogspot.com/2013/08/trouver-la-lettre-dune-colonne-partir.html">Trouver la lettre d'une colonne à partir de son numéro</a>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0tag:blogger.com,1999:blog-8133248794973819991.post-21979203068994820692013-08-05T02:01:00.002-07:002013-12-17T00:58:16.021-08:00Gérer le nom d'une feuille de calcul Excel côté VBACette méthode permet de s'affranchir du nom de l'onglet côté Excel qui peut ainsi être modifié à loisir par l’utilisateur final.<br />
<br />
1) Renommer dans le panneau des propriétés la feuille de calcul, par exemple : FInfos<br />
<br />
2) Placer le code suivant dans un module :<br />
<br />
<code>
Public Function NomFeuille(Classeur As Workbook, NomVba As String) As String<br />
NomFeuille = Classeur.VBProject.VBComponents(NomVba).Properties("Name").Value<br />
End Function</code>
<br />
<br />
3) Puis faire appel à cette fonction dans une procédure quelconque :<br />
<br />
<code>
Dim wb as Workbook<br />
Dim ws as Worksheet<br />
Dim NomReel as String<br />
<br />
Set wb = ThisWorkbook<br />
NomReel = NomFeuille(wb, "FInfos") 'Le 2e paramètre correspond au nom donné à l'étape 1<br />
Set ws = wb.Sheets(NomReel)<br />
</code>Davidhttp://www.blogger.com/profile/01852704104954906635noreply@blogger.com0