FAQ Excel
FAQ ExcelConsultez toutes les FAQ
Nombre d'auteurs : 46, nombre de questions : 845, dernière mise à jour : 30 mars 2022
Sommaire→Les macros VBA→Les UserForm et les contrôles→Les contrôles- Comment utiliser les contrôles dans les UserForm ?
- Comment gérer les évènements dans un WebBrowser ?
- Comment créer une page html dynamiquement dans un WebBrowser et y ajouter une fonction JavaScript ?
- Comment faire défiler un texte dans un UserForm ?
- Comment forcer l'affichage dans le WebBrowser lors de la navigation dans des pages html ?
- Comment visualiser un graphique dans un UserForm ?
- Comment lier le contenu d'un contrôle Spreadsheet pour créer graphique ChartSpace ?
- Comment charger les données d'une feuille de calcul dans un contrôle SpreadSheet ?
- Comment utiliser l'objet OWC PivotTable dans un UserForm Excel ?
- Comment afficher le contenu d'une feuille de calcul dans un DataGrid ?
- Comment rendre un Frame transparent afin de voir l'image située en arrière plan ?
- Comment sauvegarder les paramètres des contrôles ?
- Comment ajouter des contrôles dynamiquement dans un Frame ?
- Comment remplir une ComboBox sans doublon et trié par ordre croissant ?
- Comment alimenter rapidement une ComboBox à partir de données contenues sur une ligne de la feuille de calcul ?
- Comment afficher la liste des éléments lorsque je double clique sur un ComboBox ?
- Comment contrôler un format personnalisé lors de la saisie dans un TextBox ?
- Comment utiliser un Textbox pour saisir une date dans différents formats ?
- A quoi correspond la valeur -1 de la propriété ListIndex, pour les ComboBox et ListBox ?
- Comment créer une boucle directement sur quelques contrôles prédéfinis ?
- Comment alimenter des ComboBox de manière conditionnelle et en cascade ?
- Comment adapter automatiquement les colonnes d'une ListBox au contenu d'une plage de cellules ?
- Comment forcer l'affichage d'un en-tête pour une listBox alimentée à partir de la propriété List() ou AddItem ?
- Comment alimenter une ListBox à partir d'un recordset ?
- Comment spécifier des polices type Symbole par macro ?
- Comment vérifier si le contenu de deux contrôles Image sont identiques ?
- Comment identifier sur quel contrôle l'utilisateur a cliqué ?
- Comment cocher automatiquement tous noeuds enfants d'un TreeView ?
- Comment changer la couleur de fond dans un TreeView ?
- Comment effectuer un Glisser Déposer entre deux contrôles ListView ?
- Comment installer les contrôles MonthView et DTPicker ?
- A quoi sert la propriété TripleState des CheckBox ?
- Comment afficher un FaceID dans un contrôle Image d'un UserForm ?
- Comment gérer le menu contextuel 'Contrôles supplémentaires' s'il n'est pas accessible dans la boîte à outils ?
- Comment implémenter une auto-complétion sur un contrôle TextBox ?
- Comment gérer des contrôles dans une variable tableau ?
Consultez le tutoriel pour utiliser les contrôles dans un UserForm.
Cet exemple montre comment gérer l'évènement Clic sur toutes les images contenues dans un WebBrowser, en passant par un module de classe.
La procédure permet de renvoyer des informations sur chaque image :
*URL
*Nom
*Dates de création et de modification
*Type
*Dimensions
*Taille
La procédure nécessite d'activer la référence "Microsoft HTML Object Library".
'--------------------------------------
'A placer dans un module standard
Option Explicit
Public Collect As Collection
'--------------------------------------'--- A placer dans un UserForm ---
'---
'Nécessite d'activer la référence "Microsoft HTML Object Library".
'---
Option Explicit
Dim maPageHtml As HTMLDocument
Private Sub UserForm_Initialize()
WebBrowser1.Navigate "http://www.developpez.com"
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim Cl As Classe1
Dim i As Integer
Dim imgHtml As HTMLImg
Set Collect = New Collection
Set maPageHtml = WebBrowser1.Document
'Boucle sur les liens contenus dans le WebBrowser
For i = 0 To maPageHtml.images.Length - 1
Set imgHtml = maPageHtml.images.Item(i)
'ajoute l'objet dans la classe
Set Cl = New Classe1
Set Cl.Img = imgHtml
Collect.Add Cl
Next i
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, _
URL As Variant, Flags As Variant, TargetFrameName As Variant, _
PostData As Variant, Headers As Variant, Cancel As Boolean)
'Fait le ménage avant de charger une nouvelle page
Set Collect = Nothing
Set maPageHtml = Nothing
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
'Empèche d'ouvrir le lien dans une nouvelle fenêtre
Cancel = True
End Sub
'---------'--------------------------------------
'A placer dans un module de classe nommé "Classe1"
'
Option Explicit
'Nécessite d'activer la référence "Microsoft HTML Object Library"
Public WithEvents Img As MSHTML.HTMLImg
'Exemple pour gérer l'évènement clic sur les objets
'type MSHTML.HTMLImg (images) dans le WebBrowser.
Private Function Img_onclick() As Boolean
MsgBox "Adresse (URL): " & Img.src & vbCrLf & vbCrLf & _
"Nom: " & Img.nameProp & vbCrLf & _
"Créé le: " & Img.fileCreatedDate & vbCrLf & _
"Modifié: " & Img.fileModifiedDate & vbCrLf & _
"Type: " & Img.mimeType & vbCrLf & _
"Dimensions: " & Img.Width & " x " & Img.Height & " pixels" & vbCrLf & _
"Taille: " & Img.fileSize & " octets."
End Function
'--------------------------------------Private Sub UserForm_Initialize()
'-------
'Cette procédure permet de créer une page dynamiquement
'dans un WebBrowser :
' *Un texte
' *Une image de fond
' *Une fonction JavaScript
' *Un bouton qui permet de déclencher la fonction
'
'-------
Dim AjoutFonction As String
Dim Fichier As String
'Définit l'image de fond
Fichier = "https://vb.developpez.com/cours/images/cours_vb.gif"
'Création d'une page vierge qui va servir de support
WebBrowser1.Navigate "about:<html><body></body></html>"
'--- texte ---
AjoutFonction = "<html><body><B>Bienvenue sur cette page.</B>" & vbCrLf
'--- image de fond ---
AjoutFonction = AjoutFonction & "<BODY background='" & Fichier & "'</BODY>"
'---------------------
'--- bouton ---
AjoutFonction = AjoutFonction & "<FORM>" & _
"<INPUT type=button name='Bouton1' value='Cliquez ici.' " & _
"onClick=(alert('Bonjour!'))></FORM>"
'--------------
'--- fonction javascript ---
AjoutFonction = _
AjoutFonction & "<script language=""javascript"">" & vbCrLf
AjoutFonction = AjoutFonction & "function maFonction(){" & vbCrLf
AjoutFonction = AjoutFonction & "alert(""Coucou"");" & vbCrLf
AjoutFonction = AjoutFonction & "}" & vbCrLf
AjoutFonction = AjoutFonction & "</script></body></html>"
'---------------------------
'Insertion de la fonction JavaScript dans le WebBrowser
WebBrowser1.Document.writeln AjoutFonction
End SubSi vous souhaitez ajouter un bouton qui déclenche la fonction JavaScript par macro, utilisez :
Private Sub CommandButton1_Click()
'
'Cette procédure montre comment déclencher, par macro VB/VBA, la fonction
'JavaScript contenue dans la page html précédemment créée.
'
Dim s As String
Dim maPageHtml As HTMLDocument
Set maPageHtml = WebBrowser1.Document
'Déclenchement de la fonction JavaScript par macro
maPageHtml.parentWindow.execScript "maFonction();", "javascript"
End SubUtilisez la synthaxe suivante si la fonction JavaScript contient des arguments :
Private Sub CommandButton1_Click()
'
'Cette procédure montre comment déclencher, par macro VBA, une fonction
'JavaScript contenant un argument.
'
Dim s As String
Dim maPageHtml As MSHTML.HTMLDocument
Set maPageHtml = WebBrowser1.Document
'Déclenchement de la fonction JavaScript par macro
maPageHtml.parentWindow.execScript _
"ChangeBackGround('http://NomDuSite.com/NouvelleImage.gif');", "javascript"
End SubUn exemple en utilisant un WebBrowser ("Navigateur Web Microsoft" dans la liste des contrôles supplémentaires).
' --- A placer dans le module objet du UserForm :
Option Explicit
Private Sub UserForm_Initialize()
ParametresHtml "Le forum DVP: Un texte qui défile.", "#000099"
End Sub
'scrollAmount définit la vitesse de défilement.
Private Sub ParametresHtml(LeTexte As String, LaCouleur As String)
Me.WebBrowser1.Navigate _
"about:<html><body BGCOLOR ='#CCCCCC' scroll='no'><font color= " _
& LaCouleur & " size='5' face='Arial'>" & _
"<marquee scrollAmount=3>" & LeTexte & "</marquee></font></body></html>"
End Sub
'---
Lorsque vous parcourez des pages html depuis un WebBrowser, certains liens ouvrent les pages dans des
nouvelles fenêtres, hors du navigateur web Microsoft.
Le code suivant permet de forcer l'affichage en permanence dans le WebBrowser.
Option Explicit
Dim WithEvents cible As SHDocVw.WebBrowser_V1
Private Sub cible_NewWindow(ByVal URL As String, _
ByVal Flags As Long, ByVal TargetFrameName As String, _
PostData As Variant, ByVal Headers As String, Processed As Boolean)
Processed = True
WebBrowser1.Navigate URL
End Sub
Private Sub UserForm_Initialize()
Set cible = WebBrowser1
WebBrowser1.Navigate2 "https://www.developpez.net/forums/search.php?searchid=2795245"
End SubVoici trois possibilités :
1er exemple
Sauvegardez le graphique sur le disque au format image, puis chargez cette image dans l'UserForm :
Option Explicit
Private Const Fichier As String = "C:\ImageTemp.gif"
Private Sub UserForm_Initialize()
'Supprime l'image temportaire si elle existe
If Dir(Fichier) <> "" Then Kill Fichier
'Définit le 1er graphique de la Feuil1
'exporte le graphique au format image
Worksheets("Feuil1").ChartObjects(1). _
Chart.Export Filename:=Fichier, filtername:="GIF"
'Affiche l'image dans l'UserForm
Image1.Picture = LoadPicture(Fichier)
End Sub
Private Sub UserForm_Terminate()
'Supprime l'image temporaire si elle existe
If Dir(Fichier) <> "" Then Kill Fichier
End Sub2eme exemple
Utilisez la méthode PastePicture de Stephen Bullen.
3eme exemple
Utilisez un contrôle ChartSpace dans l'UserForm, afin de créer le graphique dynamiquement
et d'interagir avec celui-ci.
Le complément Microsoft Office Web Components (Composants Web) est une collection de contrôles pour modèles d'objets
composants (Component Object Model ou COM) permettant de publier sur le Web des feuilles de calcul, des graphiques et
des bases de données. Ces contrôles peuvent aussi être utilisés dans vos classeurs Excel.
Complément d'Office 2003: composants Web Office.
Office XP Tool: Web Components.
Un exemple simple de création :
Ajoutez un contrôle Microsoft Office Chart et un CommandButton dans l'UserForm :
Private Sub CommandButton1_Click()
Dim i As Integer
Dim S1 As Object
Dim TabX(10), TabY(10)
'Utilisez l'objet WCChart pour la bibliothèque OWC9.
'Dim Cht As WCChart
'Utilisez l'objet ChChart dans les bibliothèques OWC10(Office 2002) et OWC11(Office 2003).
Dim Cht As ChChart
Dim C As Object
Randomize
'Remplissage des tableaux qui serviront à créer le graphique
For i = 0 To 9
TabX(i) = i
TabY(i) = Int((50 * Rnd) + 1)
Next i
Set C = ChartSpace1.Constants
Set Cht = ChartSpace1.Charts.Add
With Cht
'Type de graphique
.Type = C.chChartTypeScatterLineMarkers
.HasLegend = True
.Legend.Position = C.chLegendPositionBottom
End With
Set S1 = Cht.SeriesCollection.Add
With S1
.Caption = "Nom de la série"
.Type = C.chChartTypeLine
.SetData C.chDimCategories, C.chDataLiteral, TabX
.SetData C.chDimValues, C.chDataLiteral, TabY
End With
End SubUn autre exemple. Téléchargez le zip :
Visualiser et interagir avec un graphique dans un UserForm.
Les contrôles Spreadsheet et ChartSpace font partie du complément Microsoft Office Web Components (Composants Web) qui est une collection de contrôles pour modèles d'objets composants (Component Object Model ou COM) permettant de publier sur le Web des feuilles de calcul, des graphiques et des bases de données. Ces contrôles peuvent aussi être utilisés dans vos classeurs Excel.
Complément d'Office 2003: composants Web Office.
Office XP Tool: Web Components.
Cet exemple récupère les données du SpreadSheet (Sheet1!A1:B5) pour alimenter le ChartSpace.
Option Explicit
Option Base 1
'Nota :
'Utilisez l'objet WCChart pour la bibliothèque OWC9.
'Dim Cht As WCChart
'Bibliothèques OWC10 et OWC11
Dim Cht As ChChart
Dim C
Private Sub UserForm_Initialize()
'Spécifie la source de données pour le graphique
ChartSpace1.DataSource = Spreadsheet1
Set C = ChartSpace1.Constants
'Ajoute le graphique
Set Cht = ChartSpace1.Charts.Add
'Définit le type de graphiUE
Cht.Type = C.chChartTypeLine
End Sub
Private Sub CommandButton1_Click()
'Intègre les données du SpreadSheet dans le controle ChartSpace
Cht.SetSpreadsheetData "Sheet1!A1:B5", False
End Sub
Vous pouvez placer le contenu de la feuille dans un tableau puis le transférer dans le contrôle SpreadSheet.
Les mises en formes ne sont pas appliquées dans la forme et les éventuelles formules de la feuille de
calcul sont remplacées par leurs valeurs brutes.
Private Sub UserForm_Initialize()
'Testé avec Excel 2007 & OWC11
Dim Tableau() As Variant
Dim x As String
x = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Address
Tableau = Range("A1:" & x)
Spreadsheet1.ActiveSheet.Range("A1:" & x) = Tableau
End SubConsultez le tutoriel et les classeurs démo
Excel 2007/Excel 2003 et OWC 11
Excel 2002 et OWC 10
Le contrôle DataGrid permet d'afficher le résultat de requêtes effectuées dans des bases de données. L'ocx MSDATGRD.ocx doit être installé sur votre poste pour que vous puissiez l'utiliser.
Vous pouvez utiliser cet objet pour afficher le contenu de feuilles de calcul Excel. Dans ce cas il est préférable (mais pas obligatoire) que celles-ci soient structurées comme une base de données : La première ligne servant à indiquer le nom des champs, à partir de la première.
Ce premier exemple effectue une requête dans la Feuil1 d'un classeur fermé et transfert le résultat dans le DataGrid.
Private Sub CommandButton1_Click()
'Nécessite d'activer la référence "Microsoft ActiveX Data Objects x.x Library".
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
'Connexion au classeur fermé "C:\monClasseurBase.xls"
Set Cn = New ADODB.Connection
With Cn
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=C:\monClasseurBase.xls; ReadOnly=False;"
.Open
End With
Set Rs = New ADODB.Recordset
'Requête sur le feuille nommé Feuil1, dans le classeur fermé.
'Ne pas oublier le symbole $ à la suite du nom de la feuille.
Rs.Open "SELECT * FROM [Feuil1$]", Cn, adOpenKeyset, adLockOptimistic
'Affichage du résultat de la requête dans le DataGrid
Set DataGrid1.DataSource = Rs
End SubCette deuxième procédure effectue la requête dans un classeur ouvert (dans la Feuil1 du classeur contenant la macro).
Remarque : Le classeur doit être préalablement sauvegardé sur le disque dur.
Private Sub CommandButton1_Click()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Set Cn = New ADODB.Connection
With Cn
.Provider = "MSDASQL"
'Le classeur doit être préalablement sauvegardé
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
"DBQ=" & ThisWorkbook.FullName & "; ReadOnly=False;"
.Open
End With
Set Rs = New ADODB.Recordset
'Ne pas oublier le symbole $ à la suite du nom de la feuille.
Rs.Open "SELECT * FROM [Feuil1$]", Cn, adOpenKeyset, adLockOptimistic
Set DataGrid1.DataSource = Rs
End SubLien : Consultez le tutoriel pour lire et écrire dans des classeurs fermés
Lorsque vous fermez un UserForm, il est parfois utile de sauvegarder les paramètres
d'un contrôle (par exemple le dernier contenu d'un TextBox) afin de réutiliser ces informations
ultérieurement, lors de la prochaine ouverture de la boîte de dialogue.
Le moyen le plus simple consiste à enregistrer ces données dans les cellules d'une feuille masquée.
Il est aussi possible d'utiliser l'instruction SaveSetting pour sauvegarder les paramètres
des contrôles (contenu, position ...) en créant une entrée dans la base de registres et ensuite
d'utiliser GetSetting pour lire la valeur de la clé dans la base de registres.
Dans cet exemple, la procédure sauvegarde automatiquement le contenu des TextBox1 et 2 lors de
la fermeture du UserForm.
Fermez votre classeur puis ré-ouvrez le. Les dernières données des TextBox apparaissent.
'Sauvegarde le contenu des TextBox lors de la fermeture du UserForm
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
SaveSetting "Mes parametres", "TextBox1", "Valeur TextBox1", TextBox1.Value
SaveSetting "Mes parametres", "Textbox2", "Valeur TextBox2", TextBox2.Value
End Sub'Récupère la valeur de la clé lors de l'ouverture du UserForm
Private Sub UserForm_Initialize()
TextBox1.Value = GetSetting("Mes parametres", "TextBox1", "Valeur TextBox1")
TextBox2.Value = GetSetting("Mes parametres", "TextBox2", "Valeur TextBox2")
End SubPour supprimer une entrée, utilisez :
DeleteSetting "Mes parametres", "TextBox2"Cet exemple ajoute 5 Textbox dans un Frame nommé Frame1 :
Dim i As Integer
Dim TxtB As Control
'boucle pour créer 5 Textbox dans le controle Frame1
For i = 1 To 5
Set TxtB = Frame1.Add("forms.Textbox.1")
With TxtB
.Left = 5
.Top = 10 + ((i - 1) * 30)
.Width = 75
.Height = 20
End With
Next iCette syntaxe fonctionne aussi pour les ListBox.
Private Sub UserForm_Initialize()
Dim Cell As Range
Dim Tableau()
Dim TempTab As Variant
Dim i As Integer, j As Integer
Dim boolVerif As Boolean
ReDim Tableau(1 To 1)
Tableau(1) = Cells(1, 1)
'Boucle sur les données de la colonne A, dans la Feuil1
For Each Cell In Worksheets("Feuil1").Range("A1:A" & _
Worksheets("Feuil1").Range("A65536").End(xlUp).Row)
boolVerif = False
'Vérifie si le contenu de la cellule existe déjà dans le tableau
For i = 1 To UBound(Tableau)
'Si la donnée existe déjà dans le tableau
If Tableau(i) = Cell Then
boolVerif = True
Exit For
End If
Next i
'Si la donnée n'existe pas dans le tableau, on augmente la taille du tableau
'et on ajoute la donnée.
If boolVerif = False Then
ReDim Preserve Tableau(1 To UBound(Tableau) + 1)
Tableau(UBound(Tableau)) = Cell
End If
'Tri le contenu du tableau par ordre croissant.
For i = 1 To UBound(Tableau)
For j = 1 To UBound(Tableau)
If Tableau(i) < Tableau(j) Then
TempTab = Tableau(i)
Tableau(i) = Tableau(j)
Tableau(j) = TempTab
End If
Next j
Next i
Next Cell
'Alimente le ComboBox
ComboBox1.List = Tableau
End SubPrivate Sub UserForm_Initialize()
Dim Tableau As Variant
Tableau = Range("A1:Z1").Value
ComboBox1.Column() = Tableau
'Autre possiblité
'ComboBox1.List() = Application.Transpose(Tableau)
End SubUtilisez la propriété DropDown dans l'évènement DblClick :
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.DropDown
End SubCet exemple permet de forcer un format de type 00/00:0000
Private Sub TextBox1_Change()
Dim strFormat As String
Dim x As Integer
x = Len(TextBox1)
strFormat = "##/##:####"
strFormat = Left(strFormat, x)
If Not TextBox1 Like strFormat Then _
TextBox1 = Left(TextBox1, x - 1)
End SubLe problème de la saisie d'une date dans un formulaire étant régulièrement posé je vous propose de le résoudre avec un module de classe autorisant plusieurs formats de saisie tout en intégrant des règles de validation et de mise en forme conditionnelle.
Les avantages de cette approche pour le développeur sont la souplesse et la facilité d'utilisation puisqu'il manipule non plus une valeur de type String mais directement une valeur de type Date. Pour l'utilisateur final le masque de saisie, l'infobulle et la mise en forme conditionnelle lui permettent d'identifier facilement ce qu'on attend de lui.
1 Fonctionnalités :
Les formats disponibles:
- Style européen(Jour Mois Année), anglais(Mois Jour Année) ou américain(Année Mois Jour)
- Affichage de l'année sur deux ou quatre chiffres
- Libre choix du séparateur parmi /-.,' et espace
Les règles de validation :
- Un intervalle de date programmable
- Valider la saisie des jours fériés
- Valider les jours de la semaine
Le format conditionnel:
- La couleur du texte et du fond peuvent être personnalisés selon l'état de la saisie.
Deux évènements permettent une interaction avec l'utilisateur final:
- Lorsque la valeur change
- Lorsque l'état change
Divers:
- L'infobulle du TextBox affiche le format attendu.
- Accepte le collage de valeur de type Date.
- Des fonctions intégrées permettent d'obtenir des informations supplémentaires tel que le numéro de
semaine (norme ISO) ou le jour julien.
2 Limites:
- Pas d'évènements Enter ou Exit.
- L'amplitude de l'intervalle est fixée à cent ans afin de permettre un affichage de l'année sur deux chiffres.
- L'année de base de l'intervalle est déterminée au moment de l'initialisation. Si elle n'est pas précisée elle est égale
à l'année en cours - 70 arrondi a la dizaine inférieure (Soit actuellement 2008-70=1938, 1938->1930).
- Seuls les jours fériés en France sont pris en compte, pour les autres pays une petite adaptation serait donc nécessaire.
3 Compatibilité :
- Excel 2000 et postérieur
- Testé avec Excel Xp et Excel 2003
ListBox1.ListIndex = -1 est utilisé pour désélectionner une ligne de la ListBox ou pour vérifier si une ligne est sélectionnée.
ListBox1.ListIndex renvoie 0 si la 1ere ligne est sélectionnée.
ListBox1.ListIndex renvoie 1 si la deuxieme ligne est sélectionnée.
ListBox1.ListIndex renvoie 2 si la troisième ligne est sélectionnée.
etc.
ListBox1.ListIndex renvoie -1 si aucune ligne n'est sélectionnée.
Cette option peut par exemple être utilisée pour éviter les doublons lors de l'alimentation d'un ComboBox:
Cette procédure boucle sur les cellules de la colonne A.
Chaque donnée est placée dans la zone d'édition du contrôle.
Si la donnée n'existe pas encore dans la liste, la valeur -1 est renvoyée.
Dans ce cas on peut alimenter le ComboBox en utilisant la méthode AddItem.
Private Sub UserForm_Initialize()
Dim j As Integer
'Récupère les données de la colonne A...
For j = 1 To Range("A65536").End(xlUp).Row
ComboBox1 = Range("A" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Range("A" & j)
Next j
End SubIl est possible d'indiquer les contrôles dans une fonction Array, puis de boucler sur les éléments du tableau :
Private Sub CommandButton1_Click()
Dim Ctrl As Variant
Dim j As Byte
For Each Ctrl In Array(TextBox1, TextBox3, TextBox5)
j = j + 1
Ctrl.Object.Value = "Champ" & j
Next
End Sub
Les données sont dans les colonnes A à D, d'un onglet nommé "Base".
La procédure effectue un remplissage conditionnel des ComboBox en fonction de ce qui est sélectionné dans le contrôle précédent :
La sélection du ComboBox1 (données colonne A) définit le contenu du ComboBox2 (données colonne B),
la sélection dans ComboBox2 définit le contenu du ComboBox3 (données colonne C) ?etc...
Option Explicit
Dim Ws As Worksheet
Dim NbLignes As Integer
Private Sub UserForm_Initialize()
'Définit la feuille contenant les données
Set Ws = Worksheets("Base")
'Définit le nombre de lignes dans la colonne A
NbLignes = Ws.Range("A65536").End(xlUp).Row
'Remplissage du ComboBox1
Alim_Combo 1
End Sub
Private Sub ComboBox1_Change()
'Remplissage Combo2
Alim_Combo 2, ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()
'Remplissage Combo3
Alim_Combo 3, ComboBox2.Value
End Sub
Private Sub ComboBox3_Change()
'Remplissage Combo4
Alim_Combo 4, ComboBox3.Value
End Sub
'Procédure pour alimenter les ComboBox
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
Dim j As Integer
Dim Obj As Control
'Définit le ComboBox à remplir
Set Obj = Me.Controls("ComboBox" & CbxIndex)
'Supprime les anciennes données
Obj.Clear
'alimente le Combobox initial (Combobox1)
If CbxIndex = 1 Then
'Boucle sur les lignes de la colonne A (à partir de la 2eme ligne)
For j = 2 To NbLignes
Obj = Ws.Range("A" & j)
'Remplit le ComboBox sans doublons
If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j)
Next j
Else
'Alimentation conditionnelle des autres Combobox en fonction de
'ce qui est sélectionnée dans le contrôle précédent :
'(La sélection du ComboBox1 définit le contenu du ComboBox2,
'La sélection du ComboBox2 définit le contenu du ComboBox3 ?etc...)
For j = 2 To NbLignes
If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = Cible Then
Obj = Ws.Range("A" & j).Offset(0, CbxIndex - 1)
If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j).Offset(0, CbxIndex - 1)
End If
Next j
End If
'Enlève la sélection dans le ComboBox
Obj.ListIndex = -1
End SubLa largeur de la ListBox et la largeur de chaque colonne s'ajustent en fonction du contenu des cellules à afficher dans l'UserForm.
Private Sub UserForm_Initialize()
Dim Plage As Range
Dim Largeur As String
Dim i As Integer
Set Plage = Range("A1:C10")
Plage.Columns.AutoFit
With ListBox1
.Width = Plage.Width + 20
.ColumnCount = Plage.Columns.Count
.List() = Plage.Value
For i = 1 To .ColumnCount
Largeur = Largeur & Plage.Columns(i).Width & ";"
Next
.ColumnWidths = Largeur
End With
End Sub
Normalement, il n'y a que la propriété RowSource qui permet d'afficher des étiquette mais il est possible de tricher
en plaçant des Labels au dessus de chaque colonne du contrôle ListBox.
Cet exemple redimensionne et repositionne la listbox afin d'ajouter des labels au dessus de chaque colonne.
Vous pourrez bien entendu adapter la procédure en fonction de votre projet.
Option Explicit
Option Base 1
Private Sub UserForm_Initialize()
Dim Plage As Range
Dim Tableau As Variant
Dim i As Integer
Dim Lbl As Control
'Plage de cellules contenant les données :
'Le contenu de la première ligne (A1:C1) va servir d'en-tête.
Set Plage = Range("A1:C10")
Tableau = ScindePlage(Plage)
With ListBox1
.ColumnCount = UBound(Tableau, 2)
'En option (à adapter)
.Top = 20
.Width = 92 * UBound(Tableau, 2)
DoEvents
.List() = Tableau
End With
For i = 1 To UBound(Tableau, 2)
Set Lbl = Me.Controls.Add("Forms.Label.1")
With Lbl
.Left = ListBox1.Left + 7 + ((i - 1) * 92)
.Top = ListBox1.Top - 10
.Width = 92
.Height = 10
.Caption = Plage.Cells(1, i)
End With
Next i
End Sub
Function ScindePlage(Cible As Range) As Variant
Dim Pl As Range
Set Pl = Cible.Offset(1, 0).Resize(Cible.Rows.Count - 1)
ScindePlage = Pl.Value
End FunctionCet exemple crée une requête dans une table Access et importe le résultat dans une Listbox d'un UserForm.
Private Sub CommandButton1_Click()
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim i As Integer, N As Integer
Dim Fichier As String
Dim Tbl() As Variant
Fichier = "C:\Documents and Settings\mimi\dossier\dataBase.mdb"
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
Fichier & ";"
Set Rs = New ADODB.Recordset
With Rs
.ActiveConnection = Cn
.Open "SELECT * FROM MaNouvelleTable" _
, , adOpenStatic, adLockOptimistic, adCmdText
End With
ListBox1.Clear
ListBox1.ColumnCount = Rs.Fields.Count
ReDim Tbl(Rs.RecordCount - 1, Rs.Fields.Count)
Do While Not Rs.EOF
For i = 0 To Rs.Fields.Count - 1
If IsNull(Rs.Fields(i).Value) = True Then
Tbl(N, i) = ""
Else
Tbl(N, i) = CStr(Rs.Fields(i).Value)
End If
Next i
N = N + 1
Rs.MoveNext
Loop
ListBox1.List() = Tbl
Rs.Close
Set Rs = Nothing
Cn.Close
Set Cn = Nothing
End Subsi vous êtes sur que les enregistrements ne contiennent pas de valeurs nulles, vous pouvez également utiliser :
With Rs
.ActiveConnection = Cn
.Open "SELECT * FROM MaNouvelleTable" _
, , adOpenStatic, adLockOptimistic, adCmdText
End With
Tbl = Rs.GetRows
With Me.ListBox1
.Clear
.ColumnCount = Rs.Fields.Count
.List = Application.Transpose(Tbl)
.ListIndex = -1
End With
Vous utilisez habituellement la syntaxe NomObject.Font.Name ="Arial" pour définir une police classique.
Ajoutez Font.Charset pour valider les polices type Symbole (Wingdings, Webdings ...).
NomObject.Font.Name ="Wingdings"
NomObject.Font.Charset = 2Un exemple en utilisant la bibliothèque Windows Image Acquisition.
Les deux contrôles Images sont supposés de même dimension.
Option Explicit
Option Base 1
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)
Private Const ImgTemp1 As String = "C:\ImgTemp1.jpg"
Private Const ImgTemp2 As String = "C:\ImgTemp2.jpg"
Private Sub CommandButton1_Click()
Dim iPic As StdPicture
Dim hCopy&
Dim Img As ImageFile
Dim Tableau1 As Variant, Tableau2 As Variant
'Place l'image dans le presse papier
Set iPic = Me.Image1.Picture
OpenClipboard 0&: EmptyClipboard
hCopy = SetClipboardData(2, iPic.Handle)
CloseClipboard
'Enregistre l'image sur le disque dur
If hCopy Then SavePicture iPic, ImgTemp1
DestroyIcon iPic.Handle
'Place l'image dans le presse papier
Set iPic = Me.Image2.Picture
OpenClipboard 0&: EmptyClipboard
hCopy = SetClipboardData(2, iPic.Handle)
CloseClipboard
'Enregistre l'image sur le disque dur
If hCopy Then SavePicture iPic, ImgTemp2
DestroyIcon iPic.Handle
Set Img = New ImageFile
Img.LoadFile "C:\ImgTemp1.jpg"
Tableau1 = Img.FileData.BinaryData
Set Img = Nothing
Set Img = New ImageFile
Img.LoadFile "C:\ImgTemp2.jpg"
Tableau2 = Img.FileData.BinaryData
Set Img = Nothing
MsgBox "Identiques: " & TableauxIdentiques(Tableau1, Tableau2)
Kill ImgTemp1
Kill ImgTemp2
End Sub
Function TableauxIdentiques(Tab1, Tab2) As Boolean
Dim i As Double
If UBound(Tab1) <> UBound(Tab2) Then
TableauxIdentiques = False
Exit Function
Else
For i = 1 To UBound(Tab1)
If Tab1(i) <> Tab2(i) Then
TableauxIdentiques = False
Exit Function
End If
Next i
End If
TableauxIdentiques = True
End FunctionPour vous simplifier la tâche et pour éviter de créer x fois la même macro, passez par un module de classe afin d'attribuer une même procédure à plusieurs contrôles de même type.
Par exemple, créez un UserForm et ajoutez y plusieurs contrôles Images.
Le code suivant permet ensuite d'identifier quel contrôle Image a été cliqué :
'--------------------------------------
'à placer dans le module objet du UserForm
Option Explicit
Private Sub UserForm_Initialize()
Dim Obj As Control
Dim Cl As Classe1
Set Collect = New Collection
'boucle sur les objets du UserForm
For Each Obj In Me.Controls
'verifie s'il s'agit d'un controle Image
If TypeOf Obj Is MSForms.Image Then
Set Cl = New Classe1
Set Cl.Img = Obj
Collect.Add Cl
End If
Next Obj
End Sub
'--------------------------------------'--------------------------------------
'dans un module de classe nommé "Classe1"
Option Explicit
Public WithEvents Img As MSForms.Image
'exemple pour gérer l'evenement clic de l'objet Image
Private Sub Img_Click()
MsgBox Img.Name
End Sub
'--------------------------------------'--------------------------------------
'dans un module standard
Option Explicit
Public Collect As Collection
'--------------------------------------Lorsque vous cochez un élément du TreeView, tous les éléments enfants sont également cochés grâce à cette procédure.
Private Sub TreeView1_NodeCheck(ByVal Node As MSComctlLib.Node)
CocheDecoche Node.Child, Node.Children, Node.Checked
End Sub
Private Sub CocheDecoche(Noeud As MSComctlLib.Node, _
NbEnfants As Integer, boolNd As Boolean)
Dim i As Integer
Dim xNoeud As Node
If NbEnfants = 0 Then Exit Sub
Set xNoeud = Noeud
For i = 1 To NbEnfants
If xNoeud.Children > 0 Then _
CocheDecoche xNoeud.Child, xNoeud.Children, boolNd
xNoeud.Checked = boolNd
If i < NbEnfants Then Set xNoeud = xNoeud.Next
Next
End SubDans un module standard :
Option Explicit
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As _
Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDans le module objet du userform :
Option Explicit
'Source :
'http://www.devx.com/vb2themax/Tip/19099
'
Const GWL_STYLE = -16&
Const TVM_SETBKCOLOR = 4381&
Const TVS_HASLINES = 2&
Private Sub UserForm_Activate()
SetTreeViewBackColor TreeView1, RGB(255, 0, 0)
End Sub
Sub SetTreeViewBackColor(TV As TreeView, ByVal BackColor As Long)
Dim lStyle As Long
Dim TVNode As Node
' set the BackColor for every node
For Each TVNode In TV.Nodes
TVNode.BackColor = BackColor
Next
' set the BackColor for the TreeView's window
SendMessage TV.hwnd, TVM_SETBKCOLOR, 0, ByVal BackColor
' get the current style
lStyle = GetWindowLong(TV.hwnd, GWL_STYLE)
' temporary hide lines
SetWindowLong TV.hwnd, GWL_STYLE, lStyle And (Not TVS_HASLINES)
' redraw lines
SetWindowLong TV.hwnd, GWL_STYLE, lStyle
End Sub
Dans cet exemple l'userform contient deux contrôles nommés ListView1 et ListView2.
La procédure permet d'effectuer un Glisser Déposer (Drag and Drop) du ListView1 vers le ListView2.
Option Explicit
Private objDrag As Object
Private boolDrag As Boolean
Private Sub UserForm_Initialize()
'----- remplissage ListView------------------------
With ListView1
'Définit le nombre de colonnes et Entêtes
With .ColumnHeaders
'Supprime les anciens entêtes
.Clear
'Ajoute 1 colonne en spécifiant le nom de l'entête
'et la largeur de la colonne
.Add , , "Nom", 80
End With
'Remplissage de la 1ere colonne (création de 3 lignes)
With .ListItems
.Add , , "Riri"
.Add , , "Fifi"
.Add , , "Loulou"
End With
'Spécifie l'affichage
.View = lvwReport
'.OLEDragMode = ccOLEDragAutomatic
End With
'--------------------------------------------------
With ListView2.ColumnHeaders
'Supprime les anciens entêtes
.Clear
'Ajoute 1 colonne en spécifiant le nom de l'entête
'et la largeur de la colonne
.Add , , "Nom", 80
End With
ListView2.View = lvwReport
'ListView2.OLEDragMode = ccOLEDragAutomatic
End Sub
Private Sub ListView1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, _
ByVal y As stdole.OLE_YPOS_PIXELS)
'Si le bouton de gauche est cliqué
If Button = 1 Then boolDrag = True
End Sub
Private Sub ListView1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, _
ByVal y As stdole.OLE_YPOS_PIXELS)
If Button = 1 And boolDrag Then
ListView1.OLEDrag
ListView1.MousePointer = ccSize
Set objDrag = ListView1.SelectedItem
End If
End Sub
Private Sub ListView2_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, _
ByVal y As stdole.OLE_YPOS_PIXELS)
If boolDrag And Not objDrag Is Nothing Then
'Ajoute un élément de ListView1 vers ListView2
ListView2.ListItems.Add , , objDrag.Text
boolDrag = False
ListView1.MousePointer = ccDefault
'Supprime l'élément dans la ListView1
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
'Désélectionne l'élément dans la listView1
If ListView1.ListItems.Count > 0 Then
ListView1.ListItems(1).Selected = False
Set ListView1.SelectedItem = Nothing
End If
End If
End Sub
Vous devez pour cela disposer de l'ocx MSCOMCT2.OCX.
S'il n'existe pas sur votre PC, vous pouvez le récupérer sur le site de Microsoft :
Téléchargez le fichier.
Décompressez le fichier cab.
Placez le ficher MSCOMCT2.OCX dans le répertoire C:\windows\System32
puis utilisez le menu Démarrer/Exécuter.
Saisissez ou collez: regsvr32 c:\windows\System32\MSCOMCT2.OCX
Cliquez sur le bouton Ok
Le Message "DllRegisterServer dans c:\windows\System32\MSCOMCT2.OCX réussi" confirme
l'installation correcte du composant.
Sous VBE Excel [Alt+F11], pour l'ajouter dans la Boite à outils :
Créez un UserForm
Menu Affichage/Boite à outils
Clic Droit sur Boite à outils ou Menu Outils/Contrôles supplémentaires
Cochez "Microsoft MonthView Control version 6.0 (SP6)" et/ou "Microsoft Date and Time Picker Control 6.0 (SP6)"
Cliquez sur le bouton OK pour valider.
Elle permet d'attribuer un état Null (Le contrôle apparaitra en grisé), si vous indiquez la valeur TripleState = True.
Option Explicit
Private Sub UserForm_Initialize()
CheckBox1.TripleState = True
CheckBox1.Value = Null
End Sub
Private Sub CheckBox1_Change()
If IsNull(CheckBox1.Value) Then
CheckBox1.Caption = "Null"
ElseIf CheckBox1.Value = False Then
CheckBox1.Caption = "False"
ElseIf CheckBox1.Value = True Then
CheckBox1.Caption = "True"
End If
End Sub
Private Sub CheckBox1_Click()
'La valeur Nulle ne génère par cet événement.
MsgBox CheckBox1.Value
End Sub
Vous pouvez utiliser les FaceId comme image dans vos UserForm. L'avantage réside dans le stockage de ces
icônes dans l'application et ne nécessite donc pas de gestion particulière des images lorsque vous transférez
le classeur sur d'autres postes utilisateurs.
L'inconvénient : une dimension trop importante du conteneur (un contrôle Image par exemple) nuit à la qualité d'affichage.
La procédure suivante affiche un FaceID dans un contrôle Image, nommé Image1.
Private Sub UserForm_Initialize()
Dim Cmb As CommandBarControl
Dim cBar As CommandBar
Set cBar = CommandBars.Add(Position:=msoBarFloating, MenuBar:=False, Temporary:=True)
Set Cmb = cBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
'964 = point d'exclamation
Cmb.FaceId = 964
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image1.Picture = Cmb.Picture
cBar.Delete
End Sub
Pour compenser cette anomalie qui survient parfois, activez l'éditeur de macros :
Menu Affichage.
Barres d'outils.
Personnaliser.
Sélectionnez l'onglet Commandes.
Cliquez sur la catégorie "Outils" (colonne de gauche).
Si vous voyez "Contrôles supplémentaires" dans la liste des commandes (colonne de droite), faites un clic
gauche sur la ligne "Contrôles supplémentaires" et gardez enfoncée la touche (l'icône de la souris change de forme).
Faites glisser la souris jusque dans la barre de menus de l'éditeur de macros.
Désormais la transaction "Contrôles supplémentaires" est disponible depuis la barre de menu VBE (la boîte à outils doit être préalablement affichée).
Voici un exemple d'auto-complétion
sur un textbox, à placer dans le module de code du formulaire.
L'UserForm doit contenir un textbox nommé txtInput.
' rentrez ici la plage des données en autocomplétion
Private Const r As String = "A1:A11"
Private sInput As String
' variable de blocage de la procédure Change
Dim blnStop As Boolean
Private Sub txtInput_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' gestion des touches d'effacement
If (KeyCode = vbKeyBack) Or (KeyCode = vbKeyDelete) Then
blnStop = True
Else
blnStop = False
End If
End Sub
Private Sub txtInput_Change()
Dim sWord As String
If blnStop Then
blnStop = False
Else
sInput = Left(Me.txtInput, Me.txtInput.SelStart)
sWord = GetFirstCloserWord(sInput)
If sWord &amp;amp; "" <> "" Then
blnStop = True
Me.txtInput.Text = sWord
Me.txtInput.SelStart = Len(sInput)
Me.txtInput.SelLength = 999999
End If
End If
End Sub
Private Function GetFirstCloserWord(ByVal Word As String) As String
Dim c As Range
For Each c In ActiveSheet.Range(r).Cells
If c.Value Like Word & "*" Then
GetFirstCloserWord = c.Value
Exit Function
End If
Next c
Set c = Nothing
End FunctionVous pouvez modifier une ligne dans la fonction GetFirstCloserWord pour rendre la procédure insensible à la casse.
If LCase(c.Value) Like LCase(Word & "*") Then
Placez ce code dans un UserForm contenant 3 TextBox et un CommandButton.
La variable tableau 'TextboxArray' récupère les contrôles TextBox lors de l'initialisation du UserForm :
Option Explicit
Dim TextboxArray(1 To 3) As msforms.TextBox
Private Sub UserForm_Initialize()
Set TextboxArray(1) = UserForm1.TextBox1
Set TextboxArray(2) = UserForm1.TextBox2
Set TextboxArray(3) = UserForm1.TextBox3
End Sub
Private Sub CommandButton1_Click()
MsgBox TextboxArray(1).Value
End Sub