LES USERFORMS Les Checkbox , Les Labels , Les combobox , Les Commandbutton , Les Listbox ,Les Multipages , Les Frames , Les Textbox , Les imageList , Les Treeview , Les Listview , Les Images , Les Webbrowser , Les calendriers , Les progressbar , Les Spreadsheet , Les Chartspaces , Les commonDialog , Les MSFlexGrid. |
Généralités Excel - page 1
Ce qui touche aux userforms - page 2
Piloter d'autres applications depuis Excel - page 3
Fonctions, événements, dates et calendriers - page 4
Formules, audits, répertoires et fichiers - page 5
Doublons, tris et filtres, variables, fichiers fermés, Access - page 6
Commentaires, gestion des erreurs, aide en ligne, recherches, tableaux, pages html, PC et système d'exploitation - page 7
Les objets dans le feuille, liens hypertextes, formats, Visual basic editor, chaines de caractères, modules de classe- page 8
Les Tableaux et graphiques Croisés Dynamiques, fichiers XML - page 9
Le Publipostage Word / Excel - page 10
Librairie Windows Image Acquisition Automation Library v2.0 - page 11
Ce qui touche aux userforms - page 2
Piloter d'autres applications depuis Excel - page 3
Fonctions, événements, dates et calendriers - page 4
Formules, audits, répertoires et fichiers - page 5
Doublons, tris et filtres, variables, fichiers fermés, Access - page 6
Commentaires, gestion des erreurs, aide en ligne, recherches, tableaux, pages html, PC et système d'exploitation - page 7
Les objets dans le feuille, liens hypertextes, formats, Visual basic editor, chaines de caractères, modules de classe- page 8
Les Tableaux et graphiques Croisés Dynamiques, fichiers XML - page 9
Le Publipostage Word / Excel - page 10
Librairie Windows Image Acquisition Automation Library v2.0 - page 11
LES CHECKBOX
Boucle sur les checkBox
VB:
Private Sub commandButton1_Click()
Dim Ctrl As Control
Dim Valeur As String
Dim Vr As Byte, Fx As Byte
For Each Ctrl In Me.Controls
If typeOf Ctrl Is MSForms.checkBox Then
If Ctrl.Value = True Then
Valeur = Valeur & Ctrl.Name & " = True " & Chr(10)
Vr = Vr + 1
Else
Valeur = Valeur & Ctrl.Name & " =False " & Chr(10)
Fx = Fx + 1
End If
End If
Next
msgBox Valeur & Chr(10) & Chr(10) & "Il y a " & Vr & " checkbox cochés " & Chr(10) & _
"et " & Fx & " checkbox non cochés . "
End Sub
LES LABELS
Un Label clignotant
>> Le lien sur le forum XLD
>> Le fichier zippé
Faire clignoter une flèche dans le Label d'un Userform
>> Le fichier zippé
Un label qui suit le curseur de la souris
Lors du 1er clic sur le Label , l'objet suit le curseur de la souris . Le 2eme clic permet de désactiver cette action .
Code:
Dim Cible As Boolean
Private Sub userForm_Initialize()
Cible = False
End Sub
Private Sub Label1_Click()
If Cible = True Then
Cible = False
Else
Cible = True
End If
End Sub
Private Sub Label1_mouseMove(byVal Button As Integer, byVal Shift As Integer, _
byVal X As Single, byVal Y As Single)
If Cible = True Then
Label1.Left = Label1.Left + X
Label1.Top = Label1.Top + Y
End If
End Sub
Private Sub userForm_mouseMove(byVal Button As Integer, _
byVal Shift As Integer, byVal X As Single, byVal Y As Single)
If Cible = True Then
Label1.Left = X
Label1.Top = Y
End If
End Sub
Paramétrer par macro des polices type Symbole (Wingdings ,Webdings ...) dans un Label
VB:
Label1.Font.Name ="Wingdings"
Label1.Font.Charset = 2
Utilisez le meme principe pour les Textbox
LES COMBOBOX
La methode Additem pour alimenter un combobox
VB:
Private Sub userForm_Initialize()
Dim i As Byte
For i = 1 To 5
comboBox1.addItem Cells(i, 1)
Next i
End Sub
Alimenter un Combobox sans doublon
VB:
For j = 1 To Range("A65536").End(xlUp).Row
Combobox1 = Range("A" & j)
If Combobox1.Listindex = -1 Then Combobox1.Additem Range("A" & j)
Next j
Trier les données d'un Combobox par ordre alphabétique
>> Le lien sur le forum XLD
Affecter une valeur par défaut dans un Combobox lors de son affichage
VB:
Combobox1.Listindex = 0 ' L'index 0 correspond à la première donnée contenue dans le Combobox
Boucler sur les Combobox d'un USF
Alimenter les controles Combobox1 à Combobox10 avec la plage de cellules A1:A5
VB:
For i = 1 To 10
For Each Cell In Sheets("Feuil3").Range("A1:A5")
Userform1.Controls("Combobox" & i).Additem Cell
Next Cell
Next i
Supprimer tous les items d'une comboBox
VB:
comboBox1.Clear
LES COMMANDBUTTON
Modifier les propriétés d'un bouton
VB:
Sub modifProprietesCommandButton()
'changement couleur de fond
thisWorkbook.VBProject.VBComponents("userForm1"). _
Designer.Controls("commandButton1").backColor = &H80C0FF
End Sub
Rendre un bouton actif ou inactif
VB:
commandButton1.Enabled=True 'pour activer
commandButton1.Enabled=False 'pour désactiver
Rendre un bouton visible ou invisible
VB:
commandButton1.Visible = True
commandButton1.Visible = False
Rendre un Commandbutton transparent
Dans la propriété "Backstyle" de l'objet , choisir la valeur 0 (fmBackStyleTransparent)
LES LISTBOX
La methode Additem pour alimenter une Listbox
VB:
Private Sub userForm_Initialize()
Dim i As Byte
For i = 1 To 5
listBox1.addItem Cells(i, 1)
Next i
End Sub
La propriété List pour alimenter une Listbox
VB:
Private Sub userForm_Initialize()
listBox1.List() = Range("A1:A10").Value
End Sub
Récupérer la donnée contenue dans la ligne sélectionnée
VB:
msgBox listBox1.List(listBox1.listIndex)
Si aucune ligne n'est sélectionnée la macro renvoie une erreur .Pour y remédier il est possible de tester préalablement la valeur listIndex :
Si aucune ligne n'est sélectionnée listIndex = -1 . On peut donc écrire :
VB:
If listBox1.listIndex = -1 Then Exit Sub
Compter le nombre de données dans une Listbox
VB:
Msgbox listBox1.listCount
Sélectionner la 3eme ligne dans une Listbox
VB:
Listbox1.Listindex = 2
Afficher le 3eme item de la Listbox en haut dans la zone visible
VB:
Listbox1.topIndex = 2
Exemple de boucle sur toutes les données d'une listbox
( Les numéros d'index des Listbox commencent par zéro )
VB:
For i = 0 To listBox1.listCount - 1
Msgbox Listbox1.List(i)
Next i
Transférer toutes les données d'une Listbox dans la Feuille de calcul (une solution proposée par Hervé)
VB:
With listBox1
Sheets("Feuil1").Range(Cells(1, 1), Cells(.listCount, 1)) = .List
End With
Supprimer un élément dans une Listbox
L'exemple ci-dessous enlève un Item lors d'un double clic sur la ligne
VB:
Private Sub Listbox1_Dblclick(Byval Cancel As MSForms.Returnboolean)
Listbox1.Removeitem (Listbox1.Listindex)
End Sub
Effacer tous les éléments contenus dans une Listbox (exemple avec double clic)
VB:
Private Sub Listbox1_Dblclick(Byval Cancel As MSForms.Returnboolean)
Listbox1.Clear
End Sub
Imprimer le contenu d'une Listbox
>>Le lien sur le forum XLD
Une autre solution proposée par Didier myDearFriend
VB:
Private Sub btnImprListe_Click()
Application.screenUpdating = False
thisWorkbook.Sheets.Add
With activeSheet
.Range(.Cells(1, 1), .Cells(listBox1.listCount, _
listBox1.columnCount)).Value = listBox1.List
.printOut
Application.displayAlerts = False
.Delete
Application.displayAlerts = True
End With
Application.screenUpdating = True
End Sub
Autoriser la mutiselection dans une Listbox
il faut sélectionner 1_fmMultiSelectMulti dans la propriété "Multiselect" de la Listbox
Boucler sur les lignes sélectionnées dans la Listbox
VB:
Private Sub commandButton1_Click()
Dim i As Byte
For i = 0 To Listbox1.Listcount - 1 'boucle sur les éléments de la listbox
If Listbox1.Selected(i) = True Then msgBox Listbox1.List(i)
Next i
End Sub
Définir le nombre de colonnes dans une listbox
VB:
Listbox2.columnCount = 8
Définir la largeur des colonnes d'une listBox
(Par défaut, la largeur d'une colonne est de 72 points)
Dimensions en points (72 points = 1 pouce)
VB:
listBox2.columnWidths = "60;72;60;60;40;60;60;25"
VB:
listBox1.columnWidths = "2 cm; 1,5 cm"
Alimenter une listBox sans doublons
VB:
Private Sub userForm_Activate()
Dim Cell As Range , Valeur As Range
Dim Unique As New Collection
Dim j As Byte
i = Range("A65536").End(xlUp).Row
On Error Resume Next
For Each Cell In Range("A1:A" & i)
Unique.Add Cell, CStr(Cell)
Next Cell
On Error goTo 0
For Each Valeur In Unique
Listbox1.addItem Valeur
Next Valeur
End Sub
Déplacer un Item de la Listbox d'un index vers le haut , lors d'un doubleclic sur la ligne
VB:
Private Sub Listbox1_dblClick(byVal Cancel As MSForms.returnBoolean)
Dim Cible As Integer
On Error Resume Next
With Listbox1
If .Listindex < 0 Then Exit Sub
Cible = .Listindex
If Cible = 0 Then Exit Sub
.Additem .Text, Cible - 1
.Removeitem Cible + 1
.Selected(Cible - 1) = True
End With
End Sub
Déplacer un Item de la Listbox n'importe ou dans la liste
VB:
'le premier doubleclick enregistre l'item de la Listbox dans une variable , puis supprime la ligne
'le second Double Click insère la variable en mémoire à l'emplacement du curseur
Dim Cible As Boolean
Dim Valeur As String
Private Sub Listbox1_Dblclick(byVal Cancel As MSForms.returnBoolean)
If Cible = False Then
Cible = True
Valeur = Listbox1
Listbox1.removeItem Listbox1.Listindex
Else
Cible = False
Listbox1.addItem Valeur, Listbox1.Listindex + 1
End If
End Sub
Extraire la valeur dans la 3eme colonne d'une Listbox , pour la ligne sélectionnée
VB:
msgBox Listbox1.List(Listbox1.Listindex, 2)
Additionner toutes les valeurs de la 3eme colonne
>> Le lien sur le forum XLD
Afficher des séparateurs de colonne dans une Listbox multicolonnes
VB:
Private Sub userForm_Initialize()
Dim i As Byte, j As Byte
Listbox1.Columncount = 7
Listbox1.Columnwidths = "50;15;50;15;50;15;50"
For i = 1 To 20
Listbox1.Additem "Ligne" & i
For j = 2 To 7 Step 2
Listbox1.List(Listbox1.Listcount - 1, j) = i & j
Next j
For j = 1 To 6 Step 2 'boucle pour créer les "séparateurs" de colonnes
Listbox1.List(Listbox1.Listcount - 1, j) = Chr(124)
Next j
Next i
End Sub
LES MULTIPAGES
Masquer ou afficher un multipage
VB:
multiPage1.Visible = False
multiPage1.Visible = True
Créer un multipage à la volee avec nombre de pages conditionnel et macros associées
>> Le lien sur le forum XLD
>> Le fichier zippé
L'indexation des pages
0=première page
1=deuxième page
2=troisième page
par exemple se positionner sur la page 3 lors de l'ouverture de l'USF
VB:
Private Sub userForm_Initialize()
userForm1.multiPage1.Value = 2
End Sub
Empecher l'acces à la page 2
VB:
Me.multiPage1.Pages(1).Enabled = False
Ajouter un Label dynamiquement dans la 3eme page d'un Multipage
VB:
Dim monLabel As Control
Set myLabel = multiPage1.Pages(2).Controls.Add("forms.Label.1")
With monLabel
.Caption = "le forum xld"
.Left = 10
.Top = 10
.Height = 20
.Width = 90
.Object.backColor = RGB(255, 0, 0)
End With
Vérifier si la page 2 du multipage est active
VB:
If Me.multiPage1.selectedItem.Index = 1 Then msgBox "La page 2 est active"
Afficher le nom de la page sélectionnée
VB:
Private Sub multiPage1_Change()
msgBox multiPage1.selectedItem.Name
End Sub
Ajouter une page dans un Multipage
VB:
Private Sub commandButton2_Click()
Dim Pge As Page
Set Pge = multiPage1.Pages.Add
Pge.Caption = "Nouvelle page"
End Sub
Compter le nombre de pages dans le multipage
VB:
msgBox multiPage1.Pages.Count
Afficher le nom du controle qui a le focus dans la page active d'un multipage
VB:
msgBox multiPage1.selectedItem.activeControl.Name
Afficher ou masquer la 2eme page lors d'un clic sur un bouton
VB:
Private Sub commandButton1_Click()
If Me.multiPage1.Pages(1).Visible = False Then
Me.multiPage1.Pages(1).Visible = True
Else
Me.multiPage1.Pages(1).Visible = False
End If
End Sub
LES FRAMES
Boucler sur tous les objets d'un Frame
VB:
For i = 0 To Frame1.Controls.Count - 1
msgBox Frame1.Controls.Item(i).Name
Next i
Passer le Focus d'un frame vers un autre Frame
VB:
'Dans cet exemple le Textbox1 est dans le Frame1 et le Textbox5 dans le Frame2
Private Sub textBox1_Exit(byVal Cancel As MSForms.returnBoolean)
Cancel = True
On Error Resume Next
Me.Frame2.textBox5.setFocus
End Sub
Gérer l'evenement "changement de focus" pour des TextBox placés dans des Frames
Ce lien n'existe plus
LES TEXTBOX
Afficher uniquement des asterisques lors de la saisie dans un textbox
VB:
Private Sub userForm_Initialize()
Me.textBox1.passwordChar = "*"
End Sub
Aller à la ligne dans textbox en utilisant la touche clavier "Entree"
VB:
Private Sub userForm_Initialize()
With textBox1
.multiLine = True
.enterKeyBehavior = True
End With
End Sub
Forcer les majuscules dans un textbox
VB:
Private Sub textBox1_keyPress(byVal keyAscii As MSForms.returnInteger)
keyAscii = Asc(UCase(Chr(keyAscii)))
End Sub
Focus dans un Textbox et sélection du texte contenu
VB:
Private Sub userForm_Activate()
With textBox1
.setFocus
.selStart = 0
.selLength = Len(textBox1.Text)
End With
End Sub
Garder le focus dans un textbox tant qu'il est vide
VB:
Private Sub textBox1_Exit(byVal Cancel As MSForms.returnBoolean)
If textBox1.Value = "" Then Cancel = True
End Sub
Saisie uniquement des valeurs numeriques dans un textbox
VB:
'avec la virgule non valide(entier)
Private Sub textBox1_Change()
On Error Resume Next
If Not isNumeric(Right(textBox1, 1)) Then
msgBox "Le caractere saisi n'est pas valide"
textBox1 = Left(textBox1, Len(textBox1) - 1)
End If
End Sub
'avec la virgule valide(décimal)
Private Sub textBox1_Change()
On Error Resume Next
If Not isNumeric(Right(textBox1, 1)) And Right(textBox1, 1) <> "," Then
msgBox "Le caractere saisi n'est pas valide"
textBox1 = Left(textBox1, Len(textBox1) - 1)
End If
End Sub
Incrementer d'une unité la valeur d'un Textbox à chaque ouverture d'un USF
VB:
Sub lanceUSFetMajTextBox()
Dim Cible As Integer
Cible = thisWorkbook.VBProject.VBComponents("userForm1").Designer.Controls("textBox1").Value
thisWorkbook.VBProject.VBComponents("userForm1").Designer _
.Controls("textBox1").Value = Format(Cible + 1, "000")
userForm1.Show
End Sub
Rechercher un fichier Texte et afficher le contenu dans un textBox
VB:
Private Sub commandButton1_Click()
Dim Fichier As String
Dim valeur As Long
Dim Cible As String
Fichier = Application.getOpenFilename("Text Files ([B].[/B]), [B].[/B]")
If Fichier = "Faux" Then Exit Sub
Open Fichier For Input As #1 'recup données fichier texte
valeur = fileLen(Fichier)
Cible = Input(valeur, 1)
Close #1
textBox1 = Cible
End Sub
Insertion automatique du séparateur lors de la saisie d'une date dans un Textbox
VB:
Private Sub Textbox1_Change()
Dim Valeur As Byte
Textbox1.Maxlength = 8 'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(Textbox1)
If Valeur = 2 Or Valeur = 5 Then Textbox1 = Textbox1 & "/"
End Sub
Supprimer le symbole du saut de ligne lors de l'affichage d'un Textbox dans une cellule
VB:
Range("A1") = Application.worksheetFunction.Substitute(textBox1, vbCrLf, Chr(10))
Récupérer la position du curseur dans le Textbox
VB:
msgBox textBox1.selStart
Afficher le numéro de ligne d'un Textbox , à l'emplacement du curseur de la souris
VB:
Msgbox textBox1.curLine
Déclencher la tabulation automatique lorsque le nombre de caracteres maxi autorisé est atteint
VB:
Private Sub userForm_Initialize()
textBox1.maxLength = 4
textBox1.autoTab = True
End Sub
Boucler sur tous les Textbox d'un USF pour en récupérer le contenu
VB:
Dim Ctrl As Control
For Each Ctrl In Me.Controls
If typeOf Ctrl Is MSForms.Textbox Then Msgbox Ctrl.Object.Value
Next Ctrl
Forcer un format date type xx/xx/xxxx dans le Textbox
VB:
Private Sub textBox1_Change()
Dim Valeur As Byte
textBox1.maxLength = 10 'nb caracteres maxi dans textbox
Valeur = Len(textBox1)
If Valeur = 2 Or Valeur = 5 Then textBox1 = textBox1 & "/"
End Sub
Ensuite pour vérifier que c'est bien une date qui a été saisie
Private Sub commandButton1_Click()
If Not isDate(textBox1.Value) Then
msgBox "Format incorrect"
textBox1 = ""
Exit Sub
Else
msgBox "Format correct"
'...la suite de la procedure
End If
End Sub
Simuler l'utilisation d'un raccourci clavier dans un Textbox
Le lien sur le forum XLD
LES IMAGESLIST
Les Imagelist permettent de stocker et de gérer des images ( jpg ,bmp ,ico , gif ) à l'intérieur d'un classeur
Ajouter ou changer les images manuellement
Dans les propriétés de l'Imagelist :
sélectionne "Personnalisé"
puis l'onglet "image"
clique sur le bouton "inserer images"
et choisit tes icônes ou images
Le lien sur le forum XLD
Le fichier zippé
Insérer de façon manuelle des images ou des icones dans une Imagelist
Le lien sur le forum XLD
Exporter sur le disque dur toutes les images d'une imageList
Toutes les images sont supposées etre au format .jpg
VB:
Dim Img As listImage
For Each Img In imageList1.listImages
savePicture Img.Picture, "C:\export_Image_" & Format(Img.Index, "00") & ".jpg"
Next Img
Coller dans la feuille de calcul une image issue d'une imageList
Ce lien n'existe plus
D'autres informations sur les imageList
Le lien sur Internet
Voir aussi les chapitres Listview & Treeview pour visualiser d'autres exemples d'utilisation des imageList par macro
LES TREEVIEW
Afficher l'arborescence d'un Treeview , dans une feuille Excel
VB:
'variable Public à placer tout en haut de la macro
Public Ligne As Integer
Private Sub commandButton2_Click()
'source : [URL='http://www.vb-helper.com/howto_treeview_load_edit_save.html'][COLOR=#0000ff]http://www.vb-helper.com/howto_treeview_load_edit_save.html[/COLOR][/URL]
If treeView1.Nodes.Count > 0 Then saveNode treeView1.Nodes(1), 1
End Sub
Private Sub saveNode(byVal n As Node, byVal Level As Integer)
If n Is Nothing Then Exit Sub
Ligne = Ligne + 1
Cells(Ligne, Level) = n.Text
saveNode n.Child, Level + 1
saveNode n.Next, Level
End Sub
Afficher le texte du premier nœud
VB:
msgBox treeView1.Nodes.Item(1).Text
Afficher le mot clé du premier nœud
VB:
msgBox treeView1.Nodes.Item(1).Key
Déployer la totalité de l'architecture du Treeview
VB:
Private Sub commandButton1_Click()
Dim i As Byte
For i = 1 To treeView1.Nodes.Count
treeView1.Nodes.Item(i).Expanded = True
Next
End Sub
Afficher le texte de chaque Node parent , ainsi que le nombre d'enfants associés
VB:
Private Sub commandButton1_Click()
Dim intChild As Integer, i As Integer
For i = 1 To treeView1.Nodes.Count
intChild = Val(treeView1.Nodes.Item(i).Children)
If intChild > 0 Then msgBox treeView1.Nodes.Item(i).Text & " " & LTrim(Str(intChild))
Next
End Sub
Quelques actions sur les Treeview
Représentation des nœuds par des images ( l'image change lors du focus sur un nœud )
Afficher l'architecture du Treeview , dans la Feuil2 du classeur
Activer le focus sur un nœud spécifique , choisi dans une Combobox
Ajouter une Checkbox à chaque noeud
Compter le nombre de Checkbox cochés dans le Treeview
Masquer ou Afficher les images dans le Treeview
Le lien sur le forum XLD
Le fichier zippé
Cocher ou décocher les sous éléments d'un noeud spécifique , en fonction du Check sur cet élément
VB:
Private Sub treeview1_nodeCheck(byVal Node As MSComctlLib.Node)
Dim n As Integer
If Node.Children > 0 Then
n = Node.Child.Index
Node.Child.Checked = Node.Checked
While n <> Node.Child.lastSibling.Index
treeView1.Nodes(n).Next.Checked = Node.Checked
n = treeView1.Nodes(n).Next.Index
Wend
End If
End Sub
Exemple de Treeview dont la matrice est dans la feuille de calcul
Le lien sur le forum XLD
Le fichier zippé
Rechercher un texte dans le Treeview , et appliquer le focus sur cet élément
VB:
Option Compare Text
Private Sub commandButton3_Click()
Dim nodX As Node
Dim Cible As String
Cible = inputBox("Saisir le mot recherché", "Recherche Texte dans Treeview")
If Cible = "" Then Exit Sub
For Each nodX In treeView1.Nodes
If nodX.Text = Cible Then
nodX.Selected = True
treeView1.setFocus
Exit Sub
End If
Next
msgBox "Valeur " & Cible & " non trouvée dans le Treeview ."
End Sub
Supprimer le nœud sélectionné
VB:
treeView1.Nodes.Remove (treeView1.selectedItem.Index)
Supprimer tous les éléments d'un treeView
VB:
treeView1.Nodes.Clear
Visualiser dans un Treeview les sous dossiers d'un répertoire
option: une Listview permet d'afficher les noms de fichiers , les propriétés et les icones
lien sur le forum XLD
Le fichier zippé
La version au format XLA
Le fichier zippé
Une autre version qui permet de récupérer toutes les propriétés des fichiers, sans les ouvrir
Utilisation de la méthode getDetailsOf (necessite d'activer la reference Microsoft Shell Controls and Automation)
Le fichier zippé
Multisélection dans un treeview
Il faut tout d'abord afficher les Checkboxes associés à chaque nœud :
VB:
Treeview1.Checkboxes = True
VB:
Private Sub commandButton3_Click()
Dim nodX As Node
For Each nodX In treeView1.Nodes
If nodX.Checked = True Then msgBox nodX.Text
Next
End Sub
Afficher le nom du Parent pour l'élément sélectionné
VB:
msgBox treeView1.Nodes.Item(treeView1.selectedItem.Index).Parent.Text
Empecher l'affichage Du 3eme nœud dans le Treeview
VB:
Private Sub treeView1_Expand(byVal Node As MSComctlLib.Node)
If Node.Index = 3 Then Node.Expanded = False
End Sub
Vérifier si l'élément sélectionné est le premier ou le dernier du nœud
VB:
If treeView1.selectedItem.Index = treeView1.selectedItem.firstSibling.Index Then msgBox "premier"
[CODE=vb]If treeView1.selectedItem.Index = treeView1.selectedItem.lastSibling.Index Then msgBox "dernier"
Trier les noeuds
Les Treeview possèdent une propriété de tri (Sorted) qu'il est possible de spécifier lors de la création de chaque noeud
VB:
Dim Nd As Node
Set Nd = treeView1.Nodes.Add(, , "maClé", "Le texte", "Image1", "Image2")
Nd.Sorted = True
LES LISTVIEW
Lister les fichiers JPG ou AVI d'un repertoire
Le lien sur le forum XLD
Le fichier zippé
Gestion d'un annuaire telephonique avec rappel des dates d'anniversaire
Le lien sur le forum XLD
Le fichier zippé
Lister tous les fichiers d'un répertoire , ainsi que l'icône de l'executable associé à chaque fichier
Le lien sur le forum XLD
Le fichier zippé
Déselectionner tous les items d'une listView
VB:
Set listView1.selectedItem = Nothing
Ce qui donne par exemple lors de l'initialisation :
…
VB:
Set listView1.selectedItem = Nothing
commandButton1.setFocus
Une autre solution
VB:
For X = 1 To listView1.listItems.Count
listView1.listItems(X).Selected = False
Next
Le fichier zippé
Supprimer la 3eme ligne dans une listView
VB:
ListView1.Listitems.Remove 3
Supprimer la ligne active
VB:
Listview1.listItems.Remove (Listview1.selectedItem.Index)
Modifier le texte dans la 3eme colonne de la premiere ligne
VB:
ListView1.listItems(1).listSubItems(2).Text = "le forum XLD"
Modifier la couleur du 2eme sous élément dans la 1ere ligne d'une listView
VB:
listView1.listitems(1).listSubItems(2).foreColor = RGB(100, 0, 100)
Changer la couleur du texte lorsque la ligne est sélectionnée
Le lien sur le forum XLD
Lien supprimé
Modifier le texte dans la 1ere colonne de la 4eme ligne
VB:
listView1.listItems(4).Text = "le forum XLD"
La multi selection dans une Listview
Il faut avant tout passer la propiété Multiselect à True
Ensuite pour sélectionner plusieurs lignes : ( en attendant de trouver mieux )
Cliquez sur les lignes en gardant enfoncé la touche Ctrl
VB:
'Pour boucler sur les lignes sélectionnées
Dim i As Integer
For i = 1 To listView1.listItems.Count
If listView1.listItems(i).Selected = True Then msgBox listView1.listItems(i).Text
Next
Empecher la modification manuelle des données dans Le Listview
VB:
Listview1.labeledit = 1
Afficher le 23eme item dans la partie visible de la Listview
VB:
listView1.listItems(23).ensureVisible
Afficher le 8eme item de la listView dans la premiere ligne de la partie visible (l'équivalent de Topindex)
VB:
Dim i As Integer
For i = 1 To listView1.listItems.Count
listView1.listItems(i).ensureVisible
If 8 = listView1.getFirstVisible.Index Then Exit For
Next i
Afficher l'item sélectionné dans la premiere ligne de la partie visible
VB:
Dim i As Integer
For i = 1 To listView1.listItems.Count
listView1.listItems(i).ensureVisible
If listView1.selectedItem.Index = listView1.getFirstVisible.Index Then Exit For
Next i
Effacer les données d'une listview
VB:
listView1.listItems.Clear
Transférer le contenu d'une listview dans une feuille
VB:
Dim i As Integer
Dim j As Byte
For i = 1 To listView1.listitems.Count
Cells(i, 1) = listView1.listitems(i).Text
For j = 1 To listView1.columnHeaders.Count - 1
Cells(i, j+1) = listView1.listitems(i).listSubItems(j).Text
Next j
Next i
Afficher L'option des cases à cocher dans une Listview
VB:
Me.listView1.checkBoxes = True
Transférer les informations dans la feuille de calcul lorsqu'une ligne est cochée dans la listView
VB:
Private Sub listView1_itemCheck(byVal Item As MSComctlLib.listItem)
Dim J As Byte
Dim i As Integer
If Item.Checked = True Then
i = Range("A65536").End(xlUp).Row + 1
Cells(i, 1) = listView1.listitems(Item.Index).Text %% For J = 2 To listView1.columnHeaders.Count - 1
Cells(i, J) = listView1.listitems(Item.Index).listSubItems(J).Text
Next J
End If
End Sub
Alimenter une listView avec uniquement les cellules visibles de la Feuil2
Le lien sur le forum XLD
Quelques astuces au sujet des Listview , proposées par Jean Marie (chTi160)
Afficher des icones dans les entetes de colonnes (dans le message du 22/10/2005 22:14 )
Centrer une colonne de la Listview (dans le message du 23/10/2005 10:38 )
Ajuster la Largeur des colonnes à celle du Texte (dans le message du 23/10/2005 10:38 )
Trier les Colonnes (dans le message du 23/10/2005 10:38 )
Le lien sur le forum XLD
D'autres informations sur les listView
Le lien sur Internet
LES IMAGES
Chercher une image et l'inserer dans un userform
Le lien sur le forum XLD
Le fichier zippé
Afficher dans un USF l'image ( format JPG) d'une plage de cellules
Le lien sur le forum XLD
Verifier qu'une image existe avant de l'afficher dans l'USF
(Si le fichier n'existe pas l'objet Image1 reste vide )
VB:
Fichier = thisWorkbook.Path & "\" & leNom & ".jpg"
If Dir(Fichier) <> "" Then
Image1.Picture = loadPicture(Fichier) 'si le fichier image existe
Else
Image1.Picture = loadPicture("")'si le fichier image n'existe pas
End If
Comment visualiser une image animée (.gif) dans un userform
tu dois prealablement insérer l'objet webBrowser dans l'userForm
Si cet objet n'apparaît pas par defaut dans la boite à outils :
clic droit dans la boite à outils
controles supplémentaires
coches la ligne Microsoft Navigateur Web
cliques que OK pour valider
ensuite tu inseres cette macro dans l'USF
VB:
Private Sub userForm_Initialize()
webBrowser1.Navigate "C:\monImage.gif"
End Sub
Coller l'image d'une plage de cellules dans la propriété Picture d'un Objet .
Sélectionnez une plage de cellules dans la feuille de calcul
Ctrl + C pour copier la plage
Sélectionnez la propriété "Picture" du userForm ( ou d'un autre objet : commandButton , Image ...)
Ctrl+V pour effectuer le collage
Utilisez des Scrollbars pour vous déplacer dans une image dont la taille est superieure à celle de l'objet
Lorsque vous utilisez l'objet Image , vous pouvez uniquement visualiser le résultat en mode Stretch , Zoom ou Clip .
Pour visualiser un fichier à sa taille réelle et avoir la possibilité de s'y déplacer meme si sa dimension est superieure à celle de l'objet , insérez l'objet Image dans un Frame puis utilisez la macro ci dessous :
VB:
Private Sub userForm_Initialize()
Image1.autoSize = True
Image1.Picture = loadPicture("C:\Documents and Settings\michel\dossier\monImage.jpg")
With Me.Frame1
.scrollBars = fmScrollBarsBoth
.scrollHeight = Image1.Height
.scrollWidth = Image1.Width
End With
End Sub
LES USERFORMS
Débuter avec les Userforms
Le fichier zippé
Un autre exemple
Lien supprimé
Afficher un userform non modal ( la feuille de calcul reste accessible ) pour les versions Excel ulterieures à 97
VB:
userForm1.Show 0
VB:
userForm1.Show False
VB:
userForm1.Show vbModeless
Un userform non modal pour Excel 97 ( solution de Stephen Bullen )
Le lien sur le forum XLD
Le fichier zippé
Imprimer un USF sans la couleur de fond
VB:
Private Sub commandButton1_Click()
Dim Couleur As String
Application.screenUpdating = False
Couleur = Me.backColor
Me.backColor = &H80000009
Me.printForm
Me.backColor = Couleur
Application.screenUpdating = True
End Sub
Afficher un USF en pleine page
VB:
Private Sub userForm_Activate()
With Me
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
End Sub
Affichage temporaire d'un userform
VB:
Private Sub userForm_Activate()
Application.Wait Now + timeValue("00:00:10")'10 secondes
Unload userForm1
End Sub
Désactiver la fermeture d'un USF par la croix
ATTENTION : pensez à créer un bouton de sortie pour ne pas bloquer l'application
VB:
Private Sub userForm_queryClose(Cancel As Integer, closeMode As Integer)
If closeMode = 0 Then Cancel = True
End Sub
Masquer la boite de dialogue sans la décharger
VB:
userForm1.Hide
Fermer la boite de dialogue
VB:
Unload userForm1
VB:
Unload Me
Fermer tous les USF ouverts en une seule fois
VB:
Private Sub Commandbutton1_Click()
End
End Sub
Pour définir les valeurs des objets lors de l'ouverture d'un Userform : utiliser l'évènement Initialize
Exemple :
VB:
Private Sub Userform_Initialize()
Checkbox1 = False
Checkbox2 = True
Textbox1 = "Le forum XLD"
Textbox2 = Range("A1")
End Sub
Personnaliser l'affichage des Userforms
Personnaliser la forme de l'USF
Le lien sur le forum XLD
Le fichier zippé
Animer les Userforms lors de l'affichage
Le fichier zippé
Boucler sur l'ensemble des Userform du classeur
Le lien sur le forum XLD
Un autre exemple pour lister le nom des USF du classeur
VB:
Sub listeUserForms()
'necessite d'activer la reference Visual basic For Application Extensibility 5.3
Dim VBCmp As VBComponent
For Each VBCmp In thisWorkbook.VBProject.VBComponents
If VBCmp.Type = 3 Then msgBox VBCmp.Name
Next VBCmp
End Sub
Afficher un USF en haut et dans le coin droit de l'écran
VB:
Private Sub userForm_Initialize()
With userForm1
.startUpPosition = 3
.Left = Application.Width - Me.Width
End With
End Sub
Afficher un USF en haut et dans le coin gauche de l'écran
VB:
Private Sub userForm_Initialize()
Me.startUpPosition = 3
End Sub
Actions de temporisation dans un Userform
Le lien sur le forum XLD
Le fichier zippé
L'impression d'un USF , centrée dans la feuille
Le lien sur le forum XLD
Imprimer plusieurs USF dans une meme feuille
Le lien sur le forum XLD
Le fichier zippé
Imprimer un Userform en mode paysage
Le lien sur le forum XLD
Copier l'image d'un Userform dans la feuille active
VB:
Private Declare Sub keybd_event Lib "user32" ( _
byVal bVk As Byte, byVal bScan As Byte, byVal dwFlags As Long, _
byVal dwExtraInfo As Long)
Private Sub commandButton1_Click()
keybd_event vbKeySnapshot, 1, 0&, 0&
doEvents
Range("A1").Select
activeSheet.Paste
End Sub
Choisir parmi plusieurs USF avant de l'afficher
VB:
Sub choixUSF()
Dim i As Byte
i = ComboBox1.Value
VBA.userForms.Add("userForm" & i).Show
End Sub
Afficher une image .PNG dans un userForm
Lien supprimé
Des menus flottants dans un Userform : une démo de Ludo
Le lien sur le forum XLD
Lien supprimé
Réafficher un userform apres une prévisualisation d'impression
VB:
Private Sub commandButton1_Click()
Me.Hide
Feuil1.printPreview
Me.Show
End Sub
D'autres informations sur les userForm
Le lien sur Internet
LES WEBBROWSER
La documentation générale sur les webBrowser
Ce lien n'existe plus
Afficher un message quand une page est totalement chargée
Le lien sur le forum XLD
Le fichier zippé
Un message défilant dans le Webbrowser, avec une option pour changer la couleur et le texte
Le fichier zippé
Un message défilant dans le Webbrowser, à partir de données saisies dans une cellule (une adaptation par Bernard)
Le lien sur le forum XLD
Lien supprimé
Un texte clignotant dans un webBrowser, avec une option pour changer la couleur et le texte
Le lien sur le forum XLD
Lien supprimé
Il est possible d'adapter la procédure du classeur pour afficher le texte sur plusieurs lignes :
Comme il s'agit d'un webBrowser , il faut ecrire en Html (c'est < BR > qui te permet d'alller à la ligne) :
VB:
Private Sub userForm_Initialize()
leTexte = "Bonjour
Le forum XLD "
laCouleur = "#000099"
parametresHtml
webBrowser1.Navigate thisWorkbook.Path & "\Clignote.html"
End Sub
Préciser la couleur de fond , le type de police et la taille d'un texte dans un Webbrowser
Le lien sur le forum XLD
Afficher la source Html d'un Webbrowser
VB:
'renvoie une erreur si le Webbrower est vide
Private Sub commandButton1_Click()
Dim Cible As String
Cible = webBrowser1.Document.Body.innerHTML
msgBox Cible
End Sub
Quelques actions sur les Webbrowser
Changer le texte dans un bouton , puis appliquer le focus sur ce bouton
Afficher des informations générales sur une page html : la date de la création de la page , la date de la dernière modification , la taille de la page
Compter le nombre d'images d'une page html et lister les adresses , sans doublons .
Piloter une page html par macro : Exemple sur le moteur de recherche XLD
Le lien sur le forum XLD
Le fichier zippé
Une excellente démo de Didier ,myDearFriend pour piloter des pages internet depuis un webBrowser
voir la partie FindIT dans le classeur
Lien supprimé
Lister les liens hypertextes d'une page , sans les doublons
VB:
Private Sub commandButton1_Click()
Dim i As Integer, X As Integer
Dim Resultat As String
For i = 0 To webBrowser1.document.links.Length - 1
If inStr(Resultat, webBrowser1.document.links.Item(i)) = 0 Then 'controle des doublons
Resultat = Resultat & webBrowser1.document.links.Item(i) & vbLf
X = X + 1
Cells(X, 1) = webBrowser1.document.links.Item(i)
End If
Next
End Sub
Utiliser une barre de progression pendant le chargement d'une page
VB:
Private Sub webBrowser1_progressChange(byVal Progress As Long, byVal progressMax As Long)
On Error Resume Next
If Progress = -1 Then progressBar1.Value = 100
If Progress > 0 And progressMax > 0 Then
progressBar1.Value = Progress * 100 / progressMax
End If
End Sub
Lorsque le curseur de la souris passe sur un lien dans une page , l'URL s'affiche dans un Label (Label1) de l'USF
VB:
Private Sub webBrowser1_statusTextChange(byVal Text As String)
Label1 = Text
End Sub
Gérer une base de données d'images et les fiches d'informations associées
L'exemple permet de visualiser en une fois dans le Webbrowser toutes les images du répertoire
Le lien sur le forum XLD
Le fichier zippé
Une adaptation doit etre apportée s'il y a une apostrophe dans le nom du fichier image
VB:
S = Application.worksheetFunction.Substitute(S, "'", "'")
Récupérer l'adresse d'un popup
URL permet de recuperer le chemin des nouvelles fenetres créées
VB:
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)
Label1.Caption = URL
End Sub
Private Sub commandButton_Click()
Set cible = webBrowser1
webBrowser1.Navigate2 "[URL='http://www.ebay.fr/'][COLOR=#0000ff]http://www.ebay.fr/[/COLOR][/URL]"
End Sub
Conserver l'affichage dans le Webbrowser , lors des clics sur les liens de la page Web
VB:
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()
'source : [COLOR=#0000ff]http://www.kbalertz.com/kb_185538.aspx[/COLOR]
Set cible = webBrowser1
webBrowser1.Navigate2 "[URL='http://www.oooforum.org/forum/viewforum.php?f=9'][COLOR=#0000ff]http://www.oooforum.org/forum/viewforum.php?f=9[/COLOR][/URL]"
End Sub
Empecher l'affichage des Popups ( et des nouvelles fenetres IE )
VB:
Private Sub webBrowser1_newWindow2(ppDisp As Object, Cancel As Boolean)
Cancel = True
End Sub
Effectuer une copie d'écran de la partie visible d'un Webbrowser et coller l'image dans un document Word
Le lien sur le forum XLD
Lien supprimé
Afficher un message dans le Webbrowser , si la fenetre IE renvoie une erreur de connection
(voir le message du 26/07/2005 13:40)
Le lien sur le forum XLD
Afficher une page blanche dans le Webbrowser
VB:
webBrowser1.Navigate "about:blank"
Modifier la couleur de fond d'un Webbrowser
VB:
Private Sub userForm_Activate()
'Remarque : l'equivalence de couleur RGB en VBA est BGR en HTML
webBrowser1.Document.bgColor = RGB(205, 100, 0)
End Sub
Ne pas afficher la Scrollbar du Webbrowser
VB:
Private Sub webBrowser1_documentComplete(byVal pDisp As Object, URL As Variant)
webBrowser1.Document.body.Scroll = "no"
End Sub
Intercepter l'evenement clic dans un Webbrowser
VB:
Option Explicit
'necessite d'activer la reference Microsoft Html Object Library
Dim withEvents maPageHtml As HTMLDocument
Private Sub userForm_Initialize()
webBrowser1.Navigate "[URL="https://www.excel-downloads.com/"][COLOR=#800080]http://www.excel-downloads.com/[/COLOR][/URL]"
End Sub
Private Sub webBrowser1_documentComplete(byVal pDisp As Object, URL As Variant)
Set maPageHtml = webBrowser1.Document
End Sub
Private Function maPageHtml_onClick() As Boolean
msgBox "test"
End Function
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)
Set maPageHtml = Nothing
End Sub
Détecter l'evenement clic sur un bouton type 'input" dans un webBrowser
VB:
Option Explicit
'necessite d'activer la reference Microsoft Html Object Library
Dim withEvents Bouton As HTMLInputElement
Dim Htm As HTMLDocument
Private Sub userForm_Initialize()
webBrowser1.Navigate "C:\Documents and Settings\michel\dossier\monFormulaire.html"
End Sub
Private Sub webBrowser1_documentComplete(byVal pDisp As Object, URL As Variant)
Set Htm = webBrowser1.Document
'pour cet exemple le bouton est le 2eme objet "input" de la page... Item(1)
Set Bouton = Htm.getElementsByTagName("input").Item(1)
End Sub
Private Function Bouton_onclick() As Boolean
msgBox "Vous avec cliqué sur le bouton " & Bouton.Value
'pour cet exemple le champ formulaire est le 1er objet "input" de la page...Item(0)
Debug.Print Htm.getElementsByTagName("input").Item(0).Value
Bouton_onclick = True
End Function
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)
Set Bouton = Nothing
Set Htm = Nothing
End Sub
Lister tous les éléments d'un menu déroulant , contenu dans une page HTML
Exemple pour lister tous les auteurs du forum XLD 2eme génération
VB:
Private Sub commandButton1_Click()
'Necessite d'activer la reference Microsoft HTML Object Library
Dim maPageHtml As HTMLDocument
Dim Hsel As IHTMLElementCollection
Dim Hcible As IHTMLSelectElement
Dim i As Integer
webBrowser1.Navigate "[B]Lien supprimé[/B]"
Do
doEvents
Loop While webBrowser1.Busy
Set maPageHtml = webBrowser1.Document
Set Hsel = maPageHtml.getElementsByTagName("select")
Set Hcible = Hsel(0) 'action sur le 1er menu deroulant dans la page html
For i = 1 To Hcible.Length - 1 'boucle sur tous les element du menu déroulant
Cells(i, 1) = Hcible.Item(i).Value
Next
End Sub
Vérifier si un texte existe dans une page Html
VB:
Private Sub commandButton3_Click()
Dim maPageHtml As HTMLDocument
Dim textePage As String
webBrowser1.navigate "[URL="https://www.excel-downloads.com/"][COLOR=#800080]http://www.excel-downloads.com[/COLOR][/URL]"
Do
doEvents
Loop While webBrowser1.Busy 'attend la fin du chargement pour continuer la procedure
Set maPageHtml = webBrowser1.document
textePage = maPageHtml.documentElement.innerText
If inStr(1, textePage, "Wiki") > 0 Then
msgBox "trouvé"
Else
msgBox "pas trouvé"
End If
End Sub
Adapter l'image affichée à la taille du Webbrowser
Le lien sur le forum XLD
Lien supprimé
Afficher un document Word dans un Webbrowser
Le lien sur le forum XLD
Récupérer le texte selectionné dans le Webbrowser
VB:
Private Sub commandButton1_Click()
Dim Doc As HTMLDocument
Dim txtRange As IHTMLTxtRange
Set Doc = webBrowser1.Document
Set txtRange = Doc.Selection.createRange
msgBox txtRange.Text
End Sub
Supprimer le texte sélectionné dans le webBrowser
VB:
Private Sub commandButton1_Click()
Dim Doc As HTMLDocument
Set Doc = webBrowser1.Document
Doc.Selection.Clear
End Sub
Lister les fonctions javascript contenues dans la page affichée
VB:
Dim maPageHtml As HTMLDocument
Dim i As Integer
Set maPageHtml = webBrowser1.Document
For i = 0 To maPageHtml.Scripts.Length - 1
Debug.Print maPageHtml.Scripts(i).src
Debug.Print "-------"
Debug.Print maPageHtml.Scripts(i).Text
Debug.Print "-------"
Next i
Déclencher une fonction javascript contenue dans le Webbrowser
VB:
Dim maPageHtml As HTMLDocument
Set maPageHtml = webBrowser1.Document
maPageHtml.parentWindow.execScript "window.print()", "Javascript"
'D'autres exemples :
'maPageHtml.parentWindow.execScript "alert(navigator.appName + '/' + navigator.appVersion)", "Javascript"
'maPageHtml.parentWindow.execScript "alert('Bonjour le forum XLD')", "Javascript"
'maPageHtml.parentWindow.execScript "maFonctionjavaScript();", "Javascript"
'maPageHtml.parentWindow.execScript "maFonctionjavaScript('argument');", "Javascript"
Boucler sur frames pour en récupérer les sources
VB:
Dim Frms As Object
Dim i As Integer
Set Frms = webBrowser1.Document.frames
For i = 0 To Frms.Length - 1
Debug.Print webBrowser1.Document.frames(i).Document.all.Item.innerHTML
Next
Piloter les Radio Buttons contenus dans une page Html.
Ce lien n'existe plus
Comment créer une page dynamiquement dans un webBrowser, y ajouter et déclencher une fonction Javascript
Ce lien n'existe plus
LES CALENDRIERS
Utiliser l'objet Microsoft monthView Control 6.0
Une démo de @Christophe@
Le lien sur le forum XLD
Lien supprimé
Utiliser l'objet Microsoft Date and Time Picker Control 6.0
Une démo de @Christophe@
Le lien sur le forum XLD
Lien supprimé
Utiliser le Controle Calendar
Une démo de @+Thierry
Le lien sur le forum XLD
Le fichier zippé
Paramétrer automatiquement le calendrier sur la date du jour , lors de l'initialisation
Private Sub userForm_Initialize()
With Calendar1
.Day = Day(Now)
.Month = Month(Now)
.value=Date
End With
End Sub
LES PROGRESSBAR
Débuter : insérer un Progressbar dans un Userform
Lien supprimé
Ajouter dynamiquement un Progressbar dans un userform
Le lien sur le forum XLD
Comment Faire Une progressBar alors que je n'ai pas de Boucle
Une démo de @+Thierry
Le lien sur le forum XLD
Lien supprimé
LES SPREADSHEET
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 , des pivotTables et des bases de données.
http://www.microsoft.com/downloads/details.aspx?displaylang=fr&FamilyID=7287252C-402E-4F72-97A5-E0FD290D4B76
http://www.microsoft.com/downloads/details.aspx?FamilyID=982b0359-0a86-4fb2-a7ee-5f3a499515dd&displaylang=en#affinity
Remarque : chaque version d'OWC correspond à une version d'office et n'est pas compatible avec les autres.
Office2000 : OWC9
OfficeXP : OWC10
Office2003 : OWC11
Exporter un spreadsheet dans un nouveau classeur Excel
Me.spreadsheet1.activeSheet.Export ("C:\monFichier.xls")
Sélectionner la 3eme ligne dans le spreadSheet
Me.spreadsheet1.activeSheet.Rows(3).Select
L'evenement selection de cellules dans un spreadSheet
Une démo de Zon
Le lien sur le forum XLD
Le fichier zippé
Imprimer le contenu d'un Spreadsheet
Le lien sur le forum XLD
Lien supprimé
Insérer une date dans la cellule B2 d'un Spreadsheet , et personnaliser le format
With Spreadsheet1.activeSheet.Range("B2")
.Interior.Color = "yellow"
.Value = Format(Date, "dd mmmm yyyy")
End With
Définir la police et le format des cellules
With Me.Spreadsheet1.Cells.Font
.Bold = True
.Color = "blue"
.Italic = True
.Name = "Arial"
.Size = 14
.Underline = True
End With
Récupérer les données d'un spreadSheet (exemple la plage de cellules A1:A50) pour alimenter une Listbox
Dim i As Byte
For i = 1 To 50
listBox1.addItem Me.Spreadsheet1.Cells(i, 1)
Next
Creer un lien hypertexte dans la cellule A3 d'un Spreadsheet
With Me.Spreadsheet1.activeSheet.Range("A3")
.Hyperlink.Address = "#Spreadsheet1!E5"
.Value = "mon lien"
End With
Transférer les données d'une plage de cellules dans une variable Tableau
Option Base 1
Private Sub commandButton1_Click()
Dim Valeur(5, 2)
Dim i As Integer, j As Integer
For i = 1 To 5
For j = 1 To 2
Valeur(i, j) = Me.Spreadsheet1.Cells(i, j).Value
Next j
Next i
End Sub
Figer les volets dans un spreadSheet
Dim C
Private Sub userForm_Initialize()
Set C = spreadsheet1.Constants
Me.spreadsheet1.Cells(3, 5).freezePanes C.ssFreezeLeft
Me.spreadsheet1.Cells(2, 2).freezePanes C.ssFreezeTop
End Sub
Modifier la dimension des cellules
Private Sub userForm_Initialize()
Me.Spreadsheet1.Cells.columnWidth = 100
Me.Spreadsheet1.Cells.rowHeight = 25
End Sub
Utiliser un tableau pour remplir un Spreadsheet
Option Explicit
Option Base 1
Private Sub commandButton1_Click()
Dim x As Integer
Dim Adresse As String
Dim i As Integer
Dim Tableau() As Integer
' --- Exemple simple pour remplir un tableau ----
'Définit le nombre de lignes dans le tableau
x = 15
reDim Tableau(x)
For i = 1 To x
Tableau(i) = 5 * i
Next i
'-------------------------------------------------
Adresse = "A1:A" & UBound(Tableau)
Spreadsheet1.activeSheet.Range(Adresse) = Application.worksheetFunction.Transpose(Tableau)
End Sub
LES CHARTSPACES
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 , des pivotTables et des bases de données.
http://www.microsoft.com/downloads/details.aspx?displaylang=fr&FamilyID=7287252C-402E-4F72-97A5-E0FD290D4B76
http://www.microsoft.com/downloads/details.aspx?FamilyID=982b0359-0a86-4fb2-a7ee-5f3a499515dd&displaylang=en#affinity
Remarque : chaque version d'OWC correspond à une version d'office et n'est pas compatible avec les autres.
Office2000 : OWC9
OfficeXP : OWC10
Office2003 : OWC11
Utiliser les chartSpaces pour insérer des graphiques dans un Userform
Une demo de Zon :
Le lien sur le forum XLD
Le fichier zippé
Une démo de Myta :
Le lien sur le forum XLD
Le fichier zippé
Alimenter les points d'une courbe dans un chartSpace
Option Base 1
Private Sub userForm_Initialize()
Dim Tableau(10), Plage(10)
Dim Cht As OWC.WCChart
Dim C
Dim i As Byte
For i = 1 To 10
Plage(i) = Int((50 * Rnd) + 1) ' ordonnées
Next i
For i = 1 To 10
Tableau(i) = i 'abscisses
Next i
Set C = chartSpace1.Constants
Set Cht = chartSpace1.Charts.Add
With Cht
.Type = C.chChartTypeSmoothLineStacked
.setData C.chDimCategories, C.chDataLiteral, Tableau
.seriesCollection(0).setData C.chDimValues, C.chDataLiteral, Plage
End With
End Sub
Compter le nombre de graphiques et supprimer le premier
If chartSpace1.Charts.Count > 0 Then chartSpace1.Charts.Delete 0
'L'index du 1er graphique est 0 (chartSpace1.Charts.Delete 0 )
Supprimer la 2eme serie dans le premier graphique
Me.chartSpace1.Charts(0).seriesCollection.Delete 1
'L'index de la deuxieme série est 1 (seriesCollection.Delete 1 )
Choisir une ou plusieurs séries dans une listBox pour les afficher dans un userForm
Le lien sur le forum XLD
Lien supprimé
Un autre exemple qui affiche en plus les légendes des séries
Le fichier zippé
Modifier la couleur de la 2eme série , dans le premier graphique
Me.chartSpace1.Charts(0).seriesCollection(1).Interior.Color = RGB(125, 0, 250)
Supprimer toutes les séries dans le graphique chartSpace
Dim Cht As OWC.WCChart
Dim i As Integer
Set Cht = chartSpace1.Charts(0)
For i = Cht.seriesCollection.Count To 1 Step -1
Cht.seriesCollection.Delete i - 1
Next i
Afficher les valeurs d'une série (x) dans le graphique
Cht .seriesCollection(x).dataLabelsCollection.Add
Afficher les valeurs cumulées au dessus d'un histogramme empilé
Le lien sur le forum XLD
Le fichier zippé
Exporter un chartSpace en image au format GIF
Private Sub commandButton2_Click()
Dim Gr As OWC.chartSpace
Dim Largeur As Long, Hauteur As Long
Largeur = 560
Hauteur = 480
Set Gr = Me.chartSpace1
Gr.exportPicture "C:\grapheTemporaire.gif", "gif", Largeur, Hauteur
End Sub
Imprimer un chartSpace
Private Sub commandButton2_Click()
Dim Gr As OWC.chartSpace
Dim Largeur As Long, Hauteur As Long
Dim Ws As Worksheet
Dim nomImage As String
nomImage = "C:\grapheTemporaire.gif"
Largeur = 560
Hauteur = 480
Application.screenUpdating = False
'export du chartSpace au format image Gif
Set Gr = Me.chartSpace1
Gr.exportPicture nomImage, "gif", Largeur, Hauteur
'ajout d'une feuille dans le classeur , pour contenir l'image qui va etre imprimée
Set Ws = Worksheets.Add
Ws.Pictures.Insert(nomImage).Select
Ws.printOut 'impression
Application.displayAlerts = False
Ws.Delete 'suppression feuille
Application.displayAlerts = True
Kill nomImage 'suppression image
Application.screenUpdating = True
End Sub
Afficher un titre dans le chartSpace
With Cht
.hasTitle = True
.Title.Caption = "mon titre"
.Title.Font.Color = RGB(255, 0, 255)
.Title.Font.Underline = True
.Title.Font.Bold = True
.Title.Font.Size = 14
.Title.Position = chTitlePositionTop
End With
Ajouter un 2eme axe sur la droite du graphique , et le formater
Cht.Axes.Add Cht.Scalings(chDimValues), chAxisPositionRight, chValueAxis
With Cht.Axes(chAxisPositionRight)
.Scaling.Maximum = 100
.Scaling.Minimum = 0
.numberFormat = "0.00"
.majorUnit = 10
End With
LES PIVOTTABLES
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 , des pivotTables et des bases de données.
http://www.microsoft.com/downloads/details.aspx?displaylang=fr&FamilyID=7287252C-402E-4F72-97A5-E0FD290D4B76
http://www.microsoft.com/downloads/details.aspx?FamilyID=982b0359-0a86-4fb2-a7ee-5f3a499515dd&displaylang=en#affinity
Comment utiliser un pivotTable dans un Userform
Lien supprimé
Les Caractéristiques OLAP Liées à Excel et à l'objet OWC pivotTable
Ce lien n'existe plus
LES COMMONDIALOG
Afficher la boite de dialogue "Ouvrir" pour sélectionner un fichier et en récupérer le chemin et le nom
Private Sub commandButton1_Click()
commonDialog1.showOpen
msgBox commonDialog1.Filename
End Sub
Comment utiliser un commonDialog pour enregistrer un fichier sur le disque dur
Private Sub commandButton1_Click()
With commonDialog1
.dialogTitle = "Enregistrer le fichier sous..."
.cancelError = True
.filterIndex = 1
.initDir = "C:\"
.Filename = "nomFichier.txt"
On Error goTo Fin
.showSave
Open .Filename For Output As #1
Print #1, "essai"
Close #1
End With
msgBox "Enregistrement effectué " & CommonDialog1.Filename
Fin:
msgBox "Opération annulée"
End Sub
Afficher la palette de couleur et renvoyer le code couleur sélectionné
commonDialog1.showColor
msgBox commonDialog1.Color 'valeur type Long
LES MSFLEXGRID
Un exemple d'utilisation proposé par Hervé
Le lien sur le forum XLD
Lien supprimé
Intégrer une image dans une cellule
MSFlexGrid1.Row = 1
MSFlexGrid1.Col = 1
MSFlexGrid1.colWidth(1) = 700
MSFlexGrid1.rowHeight(1) = 700
Set MSFlexGrid1.cellPicture = loadPicture("C:\windows\slcplappl.ico")
Si vous constatez des erreurs dans la page n'hesitez pas à m'en faire part .
Toutes vos idees sont les bienvenues .

Dernière modification par un modérateur: