[REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)

MichelXld

XLDnaute Barbatruc
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.​




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
Remarque:
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)
Remarques :
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
La valeur Listindex est égale à 0 pour la 1ere ligne sélectionnée , 1 pour la 2eme ligne …etc…

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"
un exemple pour définir la dimension des colonnes en centimetres
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
L'index de la premiere ligne est égal à 0

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
Ensuite , la macro ci-dessous permer de boucler sur les élements qui ont été cochés dans le treeview :
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
Le 1er item apparaît toujours surligné lors de l'affichage mais la ligne est bien déselectionnée pour l'utilisation des macros . Pour un aspect d'esthetique et ne pas avoir le surlignage , il faut dans ce cas assigner le focus sur un autre object de l'USF
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 lien sur le forum XLD
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
Lien supprimé

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
Il est aussi possible d'écrire :
VB:
userForm1.Show False
ou
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
Si la procédure de fermeture est placée dans l'Userform , il est aussi possible d'écrire :
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, "'", "&#039")
Le lien sur le forum XLD

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 .
Michel , Mise à jour le 25 Novembre 2006
 
Dernière modification par un modérateur:

Discussions similaires

Haut Bas