Excel Downloads
Forum

Précédent   Excel Downloads Forums > Excel > Questions les plus fréquentes (FAQ) et didacticiels
[REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm) [REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)
S'inscrire FAQ Membres Calendrier Recherche Messages du jour Marquer les forums comme lus


Réponse
 
LinkBack Outils de la discussion
Vieux 08/03/2008, 18h15   #1 (permalink)
XLDnaute Barbatruc
 
Date d'inscription: février 2005
Messages: 3 829
Post [REF] Wiki 2 de MichelXld (Ce qui touche aux UserForm)
Les sujets abordés dans cette page :
  • 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.
Lien vers la wiki page 1 :Les feuilles , Les graphiques , Les images , Les propriétés des classeurs , Les sauvegardes , Les formes automatiques , Aleatoire , Les barres d'outils et les barres de menus , Les boites de dialogues intégrées , Les classeurs .
Lien vers la wiki page 2 : Les userforms : Les Checkbox , Les Labels , Les combobox , Les Commandbutton , Les Listbox ,Les Multipages , Les Frames , Les Textbox , Les imagesList , Les Treeview , Les Listview , Les Images , Les Webbrowser , Les calendriers , Les progressbar , Les Spreadsheet , Les Chartspaces , Les commonDialog , Les MSFlexGrid.
Lien vers la wiki page 3 :Piloter d'autres applications depuis Excel , Piloter ( Word , Outlook , Power Point ) , Les fichiers texte
Lien vers la wiki page 4 : Les fonctions mathématiques et trigonométriques , Les impressions , Les temporisations , Les fonctions , Les evenements , Excel , Les cellules , Copier & Coller , Les dates et les calendriers , Les spécificités Macintosh, Générer des fichiers Flash , Open Office
Lien vers la wiki page 5 : Les formules Excel , Les audits de formules , Les répertoires et les fichiers .
Lien vers la wiki page 6 : Les doublons , Les tris et les filtres , Les variables , Piloter les fichiers fermés (Excel , Access ,les fichiers DBF) .
Lien vers la wiki page 7 : Les commentaires , La gestion des erreurs , L'aide en ligne Excel , Les recherches dans un classeur, Les tableaux , Les pages html et internet , Windows Media Player , Le PC et le systême d'exploitation ,Piloter Flash , les types de boucles.
Lien vers la wiki page 8 : Piloter MSN Messenger et Windows Messenger , Les objets dans le feuille , Les liens hypertextes , Les formats , Visual basic editor , Les chaines de caractères , Les modules de classe.
Lien vers la wiki page 9 : Les mises en forme conditionnelles , Les Tableaux et graphiques Croisés Dynamiques , Gérer les fichiers XML depuis Excel , Piloter Open Office depuis Excel.
Lien vers la wiki page 10 : Le Publipostage Word / Excel.
Lien vers la wiki page 11 : Utiliser la librairie Windows Image Acquisition Automation Library v2.0 depuis Excel.

Les userForms

Les checkBox
  • Boucle sur les checkBox
    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 .
    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
    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
    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
    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
    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
    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
    comboBox1.Clear

Les Commandbutton
  • Modifier les propriétés d'un bouton
    Sub modifProprietesCommandButton()
    'changement couleur de fond
    thisWorkbook.VBProject.VBComponents("userForm1"). _
    Designer.Controls("commandButton1").backColor = &H80C0FF
    End Sub
  • Rendre un bouton actif ou inactif
    commandButton1.Enabled=True 'pour activer
    commandButton1.Enabled=False 'pour désactiver
  • Rendre un bouton visible ou invisible
    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
    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
    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
    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 :
    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
    Msgbox listBox1.listCount
  • Sélectionner la 3eme ligne dans une Listbox
    Listbox1.Listindex = 2
  • Afficher le 3eme item de la Listbox en haut dans la zone visible
    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 )
    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é)
    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
    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)
    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
    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
    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
    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)
    listBox2.columnWidths = "60;72;60;60;40;60;60;25"
    un exemple pour définir la dimension des colonnes en centimetres
    listBox1.columnWidths = "2 cm; 1,5 cm"
  • alimenter une listBox sans doublons
    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
    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
    '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
    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
    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
    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
    Private Sub userForm_Initialize()
    userForm1.multiPage1.Value = 2
    End Sub
  • Empecher l'acces à la page 2
    Me.multiPage1.Pages(1).Enabled = False
  • Ajouter un Label dynamiquement dans la 3eme page d'un Multipage
    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
    If Me.multiPage1.selectedItem.Index = 1 Then msgBox "La page 2 est active"
  • Afficher le nom de la page sélectionnée
    Private Sub multiPage1_Change()
    msgBox multiPage1.selectedItem.Name
    End Sub
  • Ajouter une page dans un Multipage
    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
    msgBox multiPage1.Pages.Count
  • Afficher le nom du controle qui a le focus dans la page active d'un multipage
    msgBox multiPage1.selectedItem.activeControl.Name
  • Afficher ou masquer la 2eme page lors d'un clic sur un bouton
    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
    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
    '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
    Visualiser la macro

Les Textbox
  • Afficher uniquement des asterisques lors de la saisie dans un textbox
    Private Sub userForm_Initialize()
    Me.textBox1.passwordChar = "*"
    End Sub
  • aller à la ligne dans textbox en utilisant la touche clavier "Entree"
    Private Sub userForm_Initialize()
    With textBox1
    .multiLine = True
    .enterKeyBehavior = True
    End With
    End Sub
  • Forcer les majuscules dans un textbox
    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
    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
    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
    '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
    Sub lanceUSFetMajTextBox()
    Dim Cible As Integer
    Cible = thisWorkbook.VBProject.VBComponents("userForm1").D esigner.Controls("textBox1").Value
    thisWorkbook.VBProject.VBComponents("userForm1").D esigner _
    .Controls("textBox1").Value = Format(Cible + 1, "000")
    userForm1.Show
    End Sub
  • Rechercher un fichier Texte et afficher le contenu dans un textBox
    Private Sub commandButton1_Click()
    Dim Fichier As String
    Dim valeur As Long
    Dim Cible As String
    Fichier = Application.getOpenFilename("Text Files (.), .")
    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
    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
    Range("A1") = Application.worksheetFunction.Substitute(textBox1, vbCrLf, Chr(10))
  • Récupérer la position du curseur dans le Textbox
    msgBox textBox1.selStart
  • Afficher le numéro de ligne d'un Textbox , à l'emplacement du curseur de la souris
    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
    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
    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
    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 imageList
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
    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
    Visualiser la macro
  • 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
    'variable Public à placer tout en haut de la macro
    Public Ligne As Integer
    Private Sub commandButton2_Click()
    'source : http://www.vb-helper.com/howto_treeview_load_edit_save.html
    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
    msgBox treeView1.Nodes.Item(1).Text
  • Afficher le mot clé du premier nœud
    msgBox treeView1.Nodes.Item(1).Key
  • Déployer la totalité de l'architecture du Treeview
    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
    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
    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
    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é
    treeView1.Nodes.Remove (treeView1.selectedItem.Index)
  • Supprimer tous les éléments d'un treeView
    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 :
    Treeview1.Checkboxes = True
    Ensuite , la macro ci-dessous permer de boucler sur les élements qui ont été cochés dans le treeview :
    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é
    msgBox treeView1.Nodes.Item(treeView1.selectedItem.Index) .Parent.Text
  • Empecher l'affichage Du 3eme nœud dans le Treeview
    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
    If treeView1.selectedItem.Index = treeView1.selectedItem.firstSibling.Index Then msgBox "premier"
    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
    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
    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 :
    …
    Set listView1.selectedItem = Nothing
    commandButton1.setFocus
    …
    Une autre solution
    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
    ListView1.Listitems.Remove 3
  • Supprimer la ligne active
    Listview1.listItems.Remove (Listview1.selectedItem.Index)
  • Modifier le texte dans la 3eme colonne de la premiere ligne
    ListView1.listItems(1).listSubItems(2).Text = "le forum XLD"
  • Modifier la couleur du 2eme sous élément dans la 1ere ligne d'une listView
    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
    Le fichier zippé
  • Modifier le texte dans la 1ere colonne de la 4eme ligne
    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
    '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
    Listview1.labeledit = 1
  • Afficher le 23eme item dans la partie visible de la Listview
    listView1.listItems(23).ensureVisible
  • Afficher le 8eme item de la listView dans la premiere ligne de la partie visible (l'équivalent de Topindex)
    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
    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
    listView1.listItems.Clear
  • Transférer le contenu d'une listview dans une feuille
    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
    Me.listView1.checkBoxes = True
  • Transférer les informations dans la feuille de calcul lorsqu'une ligne est cochée dans la listView
    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).Te xt
    Next J
    End If
    End Sub
    Le fichier zippé
  • 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 )
    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
    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 :
    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
    Le fichier zippé
  • Afficher un userform non modal ( la feuille de calcul reste accessible ) pour les versions Excel ulterieures à 97
    userForm1.Show 0
    Il est aussi possible d'écrire :
    userForm1.Show False
    ou
    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
    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
    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
    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
    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
    userForm1.Hide
  • Fermer la boite de dialogue
    Unload userForm1
    Si la procédure de fermeture est placée dans l'Userform , il est aussi possible d'écrire :
    Unload Me
  • Fermer tous les USF ouverts en une seule fois
    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 :
    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
    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
    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
    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
    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
    Sub choixUSF()
    Dim i As Byte
    i = ComboBox1.Value
    VBA.userForms.Add("userForm" & i).Show
    End Sub
  • Afficher une image .PNG dans un userForm
    Le fichier zippé
  • Des menus flottants dans un Userform : une démo de Ludo
    Le lien sur le forum XLD
    Le fichier zippé
  • Réafficher un userform apres une prévisualisation d'impression.
    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
    Le lien vers l'aide MSDN
  • 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
    Le fichier zippé
  • Un texte clignotant dans un webBrowser , avec une option pour changer la couleur et le texte
    Le lien sur le forum XLD
    Le fichier zippé
    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) :
    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
    '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
    Le fichier dans la zone de téléchargement XLD
  • Lister les liens hypertextes d'une page , sans les doublons
    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
    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
    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
    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
    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 "http://www.ebay.fr/"
    End Sub
  • Conserver l'affichage dans le Webbrowser , lors des clics sur les liens de la page Web
    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 : http://www.kbalertz.com/kb_185538.aspx
    Set cible = webBrowser1
    webBrowser1.Navigate2 "http://www.oooforum.org/forum/viewforum.php?f=9"
    End Sub
  • Empecher l'affichage des Popups ( et des nouvelles fenetres IE )
    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
    Le fichier zippé
  • 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
    webBrowser1.Navigate "about:blank"
  • Modifier la couleur de fond d'un Webbrowser
    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
    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
    Option Explicit
    'necessite d'activer la reference Microsoft Html Object Library
    Dim withEvents maPageHtml As HTMLDocument
    Private Sub userForm_Initialize()
    webBrowser1.Navigate "http://www.excel-downloads.com/"
    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
    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
    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 "http://www.excel-downloads.com/forums/index.htm"
    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
    Private Sub commandButton3_Click()
    Dim maPageHtml As HTMLDocument
    Dim textePage As String
    webBrowser1.navigate "http://www.excel-downloads.com"
    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
    L'exemple zippé
  • Afficher un document Word dans un Webbrowser
    Le lien sur le forum XLD
  • Récupérer le texte selectionné dans le Webbrowser
    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
    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
    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
    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
    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.i nnerHTML
    Next
  • Piloter les Radio Buttons contenus dans une page Html.
    Visualiser la macro
  • Comment créer une page dynamiquement dans un webBrowser, y ajouter et déclencher une fonction Javascript
    Visualiser la macro

Les calendriers
Les Progressbar
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
    Le fichier zippé
  • 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
    Le fichier zippé
    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).Inter ior.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
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
    Le fichier zippé
  • 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 MichelXld ; 08/03/2008 à 23h37.
MichelXld est déconnecté   Réponse avec citation
ANNONCES
Réponse

Liens sociaux