USERFORM

http://archive.baarns.com/excel/free/exceluts.asp
http://www.microsoft.com/france/support/produit/default.asp?uni=3&pro=21&cat=4

Grille de saisie améliorée pour remplacer celle du menu Données : news by L. L.

Enlever boutons minimiser & fermer d'un formulaire / Remove close & minimize buttons : news

Userform en plein écran : news

Désactiver le bouton de fermeture d'excel : news

Images animées/Animated images : Gif89.dll téléchargeable là, puis, Access/ Grenier ....
Userform et pointeur de souris : if Me.MousePointer = fmMousePointerCustom then Me.MouseIcon = LoadPicture("c:\mes documents\url.ico")

Ajouter un userform par macro : Set Tempform = thisworkbook.VBProject.VBComponents.add(3) . Voir aussi le site de J. Walkenbach. (tip n° T6)

Affecter une macro à un userform : workbooks("Workbook.xls").VBProject.VBComponents("Userform1").CodeModule.CreateEventProc

Empêcher l'utilisation de la croix de fermeture d'un userform (utiliser le code du bouton cmdExit à la place)

Private Sub Userform_QueryClose(Cancel As Integer, CloseMode As Integer)
if CloseMode <> vbformCode then
cmdExit_Click
end if
end Sub

Charger un userform appelé My_form en provenance d'un autre classeur :

Soit un classeur appelé myform.xls situé dans le répertoire c:\mes documents, inscrire la procédure Load_the_form dans votre classeur actif et la procédure load_my_form dans le classeur myform.xls contenant le formulaire.

Sub Load_the_form()
'your code here
ChDir "C:\My documents\"
application.run "myform.xls!Load_My_form"
'your code here
end Sub

Sub Load_My_form()
My_form.show
end Sub

Utilisation multiple d'un même formulaire/ Multiple use of one form

Sub tester1()
dim form1 As New Userform1
dim form2 As New Userform1
form1.show
form2.show
Debug.Print form1.TextBox1.Text
Debug.Print form2.TextBox1.Text
end Sub

Afficher la liste des userforms d'un classeur

Sub test()
for each x In thisworkbook.VBProject.VBComponents
Debug.Print x.name, x.type
next
end Sub

Centrer un formulaire

Public Sub Centrerform(formulaire As form)
formulaire.top = (Screen.Height - formulaire.Height) / 2
formulaire.Left = (Screen.width - formulaire.width) / 2
end Sub

Puis, dans l'évènement form_Load mettez :
Private Sub form_Load()
Centrerform Me
end Sub

Private Sub Userform_Activate()
with ActiveWindow
Me.Left = (.Left * 2 + .width) / 2 - 0.5 * Me.Insidewidth
Me.top = (.top * 2 + .Height) / 2 - 0.5 * Me.InsideHeight + (.Height - .UsableHeight) * 2.5
end with
end Sub

Comment Faire pour centrer un formulaire au milieu d'un autre Formulaire ? (pr nix)
Mettez ce code dans votre Module :

Public Sub CenterForm(MonForm As Form)
MonForm.Move (Mon1erForm.Left + (Mon1erForm.Width - MonForm.Width) / 2), (Mon1erForm.Top + (Mon1erForm.Height - MonForm.Height) / 2)
End Sub

CenterForm Mon2emeForm

Positionner le formulaire en haut à droite
dans le coin de l'écran (mettez ce code dans l'évènement Initialize du formulaire)

application.windowstate = xlmaximized
Me.Left = application.width - .width
Me.top = 0

Boucler sur les divers objets
(Textbox, combobox, ....)

dim Ctrl As Control
for each Ctrl In Userform1.Controls
if typename(Ctrl) = "TextBox" then
'......... do your thing with the Ctrl object
end if
next Ctrl

Aligner le bord gauche de tous les contrôles de la première feuille de calcul

For Each s In Worksheets(1).Shapes
If s.Type = msoOLEControlObject Then s.Left = 10
Next

Cochez les cases à cocher d'un userform

Private Sub Userform_Initialize()
dim cntrl As Control
for each cntrl In Me.Controls
if typename(cntrl) = "CheckBox" then
cntrl.value = false
end if
next
end Sub

Afficher et masquer un label

au sein d'un userform, avec un bouton de commande & l'évènement mousemove : news

Couleur d'un label : news

Contrôle Calendrier

Son installation : news
donner sa valeur à une cellule : sheets("Sheet1").range("A1").value=Calendar1.value

Private Sub Calendar1_Click()
'range("A1").Numberformat = "dd-mmm-yyyy"
range("A1").value = Me.Calendar1.value
end Sub

Dans ce cas, insèrer simplement le code à exécuter dans la procédure Userform_Activate du Userform.
Si on modifie le contenu de contrôle du Userform pour visualiser la progression, il faut exécuter l'instruction doEvents après chaque modif pour que l'affichage soit réactualisé.
Et pour éviter que l'utilisateur ferme la boîte de dialogue pendant l'exécution de Userform_Activate, annuler la fermeture par Cancel = true dans la procédure Userform_QueryClose tant que la procédure Activate est active (ici, utilisation d'un flag "Exec").

Par exemple :

dim Exec As Boolean
Private Sub Userform_Activate()
dim I As long, J As long
Exec = true
for I = 0 to 100 Step 10
Label1.Caption = I & "% réalisés"
doEvents
for J = 1 to 2000000
next J
next I
Exec = false
end Sub

Private Sub Userform_QueryClose(Cancel As Integer, CloseMode As Integer)
if Exec then Cancel = true
end Sub

Voire aussi là :

A l'adresse : http://w1.2735.telia.com/~u273500023/english/index.htm, voir rubrique Example progress bar dialogs, fichier progresbar.zip.
Ou encore : http://www.j-walk.com/ss/excel/tips/tip01.htm, http://www.j-walk.com/ss/excel/tips/tip34.htm, http://www.j-walk.com/ss/excel/files/ledbar.exe

COMBOBOX & LISTBOX

Spécifier la source de ces objets :

ComboBox1.rowsource = "[Zaza.xls]Feuil1!A2:A10"
Feuil1.ComboBox1.ListFillrange = "feuil1!A:D"
Feuil1.ComboBox1.ListFillrange = [A:D].Address

Comboxbox à source dynamique (modifiée si la plage source s'enrichit !?) : news

Transfert de date d'une ComboBox à la cellule d'une feuille : cells(1, 1) = CDate(ComboBox1.value) (10/10/99 fr.Excel, C.C.)

Récupération des valeurs d'une listbox ou d'une combobox

Feuil1.ComboBox1.List(Feuil1.ComboBox1.ListIndex)

Si la liste déroulante est celle de la barre d'outils formulaire, on en récupère le contenu en VBA avec :
msgbox sheets(1).Dropdowns(1).List(sheets(1).Dropdowns(1).ListIndex)

Si c'est une Liste de la barre d'outils Commandes sur une feuille
Private Sub ListBox1_Click()
msgbox ListBox1.value
end Sub

Propriété TextColumn

La propriété TextColumn sert à identifier la colonne de données dans un contrôle ListBox qui fournit les données à sa propriété Text.
Ainsi si vous avez 4 colonnes dans votre liste, à la sélection d'un enregistrement de la liste, la valeur retournée sera celle dont l'index de colonne correspond à TextColumn. (confus tout ça ;-)) => ComboBox1.TextColumn = 3 (implémenter l'exemple de l'aide d'excel et vous comprendrez)

Conditionner la source de la combobox1 à la valeur de la combobox 2

Private Sub ComboBox2_Change()
if ComboBox2 = "1" then ComboBox1.ListFillrange = "A1:A10" _
Else ComboBox1.ListFillrange = "B1:B10"
ComboBox1.ListIndex = 0
end Sub

Sur le même principe, si la combobox2 contient une liste de plages nommées (16/11/99 excel.programming)

(If combobox2 listed named ranges ...)
Private Sub ComboBox2_Change()
ComboBox1.ListFillrange = thisworkbook.names(ComboBox2.Text).Refersto
end Sub

Récupération choix multiples dans zone de liste (L. L.)

Il faut utiliser la propriété selected, qui renvoie un tableau de booléens (autant d'éléments qu'en contient la zone de liste) indiquant si chaque élément a été sélectionné. Si MaListe.selected(3) égale true, le troisième élément a été sélectionné.

Exemple 1

dim I As Integer, J As Integer
dim Elts()
with sheets("Feuil1").ListBoxes(1)
for I = 1 to ubound(.selected)
if .selected(I) then
J = J + 1
redim preserve Elts(1 to J)
Elts(J) = .List(I)
end if
next I
end with
activecell.resize(J) = application.transpose(Elts)

Exemple 2

Soit une ListBox1 sur la Feuil1 (Sa propriété ListFillrange va chercher A1:A5)
Je veux récupérer en D1 et suivantes une sélection multiple.
La liste ListBox1 est située dans la feuille 1. Inscrire, dans la feuille de code de Feuil1

Private Sub ListBox1_GotFocus()
ListBox1.MultiSelect = fmMultiSelectExtended
range("D1", cells(ListBox1.ListCount, 4)).Clear
End Sub

Private Sub ListBox1_LostFocus()
j = 1
with ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
cells(j, 4) = .List(i)
.Selected(i) = False
j = j + 1
End If
Next
End with
End Sub

Combobox ou listbox pour se déplacer entre feuilles

Private Sub ComboBox1_Change()
worksheets(ComboBox1.Text).select
end Sub

Private Sub Userform_Initialize()
dim sht As Worksheet
for each sht In activeworkbook.worksheets
ComboBox1.addItem sht.name
next sht
end Sub

Empêcher la saisie dans un ComboBox (30/12/1999)

1. Private Sub ComboBox1_Keydown(ByVal KeyCode As MSforms.ReturnInteger, ByVal Shift As Integer)
   KeyCode = 0
   end Sub
   
   
2. ou en interceptant la saisie manuelle (merci C.C.)
   Private Sub ComboBox1_Change()
   if ComboBox1.ListIndex = -1 then
   msgbox "pas de saisie manuelle"
   end if
   end Sub

Additionner les données d'une listbox
(I have some values in listbox1 that I would like to total in textbox1,
Jeudi 18 novembre 1999 20:22, totalling values in a listbox)

dim Thetotal As double
dim Ndx As long

with Userform1.ListBox1
for Ndx = 0 to .Listcount - 1
if IsNumeric(.List(Ndx)) then
Thetotal = Thetotal + CDbl(.List(Ndx))
end if
next Ndx
end with
Userform1.TextBox1.Text = format(Thetotal)

LISTBOX

Remplir une listbox avec une zone variable

set rng = worksheets("Sheet1").range(.cells(1,"A"),.cells(1,"A").end(xldown))
Userform1.ListBox1.rowsource = rng.address(external:=true)

Remplir une listbox avec les données d'une base type Access par DAO :
voir l'article de Microsoft : "How to Fill a Userform ListBox with Database values"

Valeur de la listbox "Liste" au format date
Liste.value = format(Liste.value, "Short Date") (1/09/1999, Combobox dans formulaire)

Comment repérer les doublons dans un listbox : news
Vérifier si un élément est déjà présent dans une liste : news
En-têtes de colonnes dans listbox : news
Transfert de valeurs sélectionnées d'une liste à une autre liste : news
Liste de critères de tri dans listbox : news
Tri de listbox (et d'arrays) : news
Taille des colonnes d'une listbox : news
Effacer d'une liste les éléments sélectionnés : news

Remplir une listbox avec des valeurs uniques /Excel 97
Filling a ListBox with Unique Items : http://www.j-walk.com/ss/excel/tips/tip47.htm (je l'ai en ma possession)

Listbox alimenté avec des arrays/variables tableau (exemple horloge) : news, news

Affecter la valeur d'une textbox à un autre objet après sa mise à jour : (microsoft.public.excel.programming, 26/10/99 par T.O.)

Private Sub Listbox1_Change()
Textbox1.Text = Listbox1.value
end sub

ou alors :
Private Sub Listbox1_Change()
set rng = worksheets("Data").range("C9:F23")
Textbox1.Text = rng(listbox1.listindex+1,2) 'Column D for the selected row
end sub

ou encore :
dim i As Integer
for i = 0 to ListBox1.Listcount - 1
sheets("sheet1").cells(i + 1, 1).value = ListBox1.List(i)
next i

TEXTBOX/ BOITE TEXTE

Evaluer l'expression contenue dans une textbox

TextBox1 = Evaluate(TextBox1.Text) => pour évaluer une expression mathématique
Si vous voulez utiliser des fonctions dans la formule, vous devrez utiliser les noms et les séparateurs anglais, par exemple
"SUMPRODUCT({1,2,3,4},{5,6,7,8})" au lieu de "SOMMEPROD({1.2.3.4};{5.6.7.8})".

TextBox3 = TextBox1+TextBox2 => ceci concatène les deux valeurs : 1 & 2 = 12
TextBox3 = Val(TextBox1) + Val(TextBox2) => ceci évalue les valeurs contenues dans les textbox et fait l'addition : 1 & 2 = 3 does the addition

Sélection des lignes X à Y ou X et Y sont les valeurs de textbox1 et textbox2 (microsoft.public.fr.excel, "Attribuer une valeur TextBox", 18/01/2000) :
sheets("Feuil1").range(cells(CDbl(TextBox1.value), 1), cells(CDbl(TextBox2.value), 1)).EntireRow.select

donner la valeur d'un textbox à une cellule après sa mise à jour

Sub TextBox1_AfterUpdate()
sheets("Sheet1").range("A1") = format(Me.TextBox3, "$ #,##0.00")
end Sub

Masque de saisie pour un textbox (ici, type date) ; utiliser par exemple l'évènement afterupdate :

Private Sub textbox1_AfterUpdate()
textbox1 = Format(CDbl(Bd7Quan), "# ##0.00")
End Sub

donner à une textbox la valeur d'une autre : Textbox1.Text = Textbox2.text
Contrôler une saisie dans un textbox (évènement exit) : news
Contrôler une saisie en comparant la valeur à une liste de format : news
Récupérer la date saisie dans une textbox : If isdate(TextBox) then [A1]=format(cdate(TextBox),"dd/mm/yyyy") else Toto=Msgbox("C'est pas une date",Vbokonly,"Erreur") exit sub endif

Sélectionner le texte d'une textbox/ Highlight text in textbox

1. Utiliser les deux instructions ci-dessous :
   TextBox1.SelStart = 0
   TextBox1.SelLength = Len(TextBox1.Text)
   
   
2. Exemple :

   Private Sub TextBox1_Keydown(ByVal KeyCode As MSforms.ReturnInteger, ByVal Shift As Integer)
   if KeyCode = 13 Or KeyCode = 9 then 'Enter & Tab respectively
   HighlightText
   end if
   end Sub

   Private Sub HighlightText()
   TextBox1.SetFocus 'text reverse
   TextBox1.SelStart = 0
   TextBox1.SelLength = Len(TextBox1.Text)
   end Sub

3. Autre bon exemple : news

Utiliser le point du pavé numérique, mais le transformer en virgule : utiliser l'évènement KEYPRESS, qui admet le paramètre entier ASCII.
cela donne ceci (pour une zone texte appelée ZoneTexte dans l'exemple) :

Private Sub ZoneTexte_KeyPress(KeyAscii As Integer)
if KeyAscii = 46 then ' si je lis une virgule
KeyAscii = 44 ' je change le code pour que ce soit un point
end if
end Sub

Astuce d'Eplucheur pour connaître le séparateur : (Objet: Re: Type de données dans un userform Date : mardi 25 juillet 2000 23:54)
MsgBox IsNumeric("5.5") retourne vrai si le séparateur est un point, faux sinon.
If Not IsNumeric("5.5") Then Virgule = True

Afficher un message pour indiquer que seul du numérique doit être saisi

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 97 And KeyAscii <= 122 Then
MsgBox ("Ne saisissez pas du texte!")
End If
End Sub

Détecter l'utilisation des flèches, qui n'ont pas de valeurs ASCII mais la valeur KeyCode
Remarque de John K. le 10 septembre 1999

vbKeyLeft 37 LEFT ARROW key
vbKeyUp 38 UP ARROW key
vbKeyRight 39 RIGHT ARROW key
vbKeydown 40 DOWN ARROW key
vbKeyTab 9 TAB key

Private Sub TextBox1_Keydown(KeyCode As Integer, Shift As Integer)
if KeyCode = vbKeyLeft then msgbox "You pressed the LEFTARROW key."
end Sub

Comment copier un texte dans une textbox malgré la limitation de caractères
XL: How to Copy Text to TextBoxes Using the Characters Method
http://support.microsoft.com/support/kb/articles/Q148/8/15.asp

la propriété default permet de déterminer, dans un userform contenant plusieurs boutons (ou contrôles) celui qui sera actionné par défaut par
Enter. Elle n'existe pas pour les boutons insérés directement dans une feuille de calcul (dans une feuille Excel, Enter sert à autre chose !)
on peut mettre Default à true ou false soit par macro (commandbutton2.Default=true) soit par la fenêtre propriétés de l'éditeur VBA.
Si on met la propriété Default à true pour un contrôle, celle de tous les autres contrôles du userform sont automatiquement passées à false (on ne
déclenche pas plusieurs boutons à la fois !) le 3/12/99 par J@C

Ecrire une checkmark/case à cocher : mettre la cellule au format Wingdings et taper Alt+0252
Macro pour créer rapidement des checkboxes : voir fichier CréationCheckBoxesDansCellules sur le site de Frédéric S.

Boutons

HS : Insérer une image sur un bouton de barre d'outils : news (26/07/99)
Colorer des boutons : activesheet.shapes("Button 2").Oleformat.object.font.colorindex = 49 / ou bien, activesheet.buttons("Button 2").font.colorindex = 49
Bouton par défaut : mybutton.Default = true ???
Créer de nombreux boutons très facilement : news

Soit une plage nommée Year contenant douze valeur/mois, chaque clic permute d'une valeur à la suivante

Private Sub CommandButton1_Click()
Static Ndx As Integer
Ndx = (Ndx Mod 12) + 1
CommandButton1.Caption = range("year")(Ndx, 1).value
end Sub

Désactiver un bouton et le griser :

Sub ChangeButton()
dim bt As Button
Set bt = activeworkbook.worksheets("Sheet1").Buttons("Button 1")
if bt.Enabled = true then
bt.Enabled = false
bt.Font.Color = RGB(255, 251, 240)
Else
bt.Enabled = true
bt.Font.Color = RGB(0, 0, 0)
end if
end Sub

Supprimer les boutons appelés bouton1, bouton2 .... (par extension supprimer les objets)

dim I As Integer
On Error Resume next
for I = 1 to 3
activesheet.Buttons("bouton" & I).delete
next

Modifier la taille de un ou plusieurs boutons

Sub test()
Dim I As Integer
On Error Resume Next
For I = 1 To 6
With ActiveSheet.Buttons("bouton " & I)
.Shaperange.Height = 103.5
.Shaperange.Width = 160.5
End With
Next
End Sub
'.Shaperange.ScaleWidth 0.55, msoFalse, msoScaleFromTopLeft '
'.Shaperange.ScaleHeight 0.9, msoFalse, msoScaleFromTopLeft

Boutons radios .... sélectionnés ?/ selected option buttons (from news 27/09/99)

Sub opttest()

'avec la barre d'outils formulaire/ 'Using the forms toolbar...
if activesheet.OptionButtons("opt1").value = xlOn then
msgbox "opt 1 is selected"
Elseif activesheet.OptionButtons("opt2").value = xlOn then
msgbox "opt 2 is selected"
end if

'avec la barre d'outils commandes/ Using the Control toolbox toolbar...
if activesheet.optInTray.value = true then
msgbox "InTray selected"
Elseif activesheet.optBooks.value = true then
msgbox "Books selected"
end if

end Sub

Texte dans une cellule

with sheets("Settings")
.range("B8").value = .Shapes("Team").TextFrame.Characters.Text
end with

Connaître la position d'un objet

msgbox activesheet.Shapes(application.Caller).topLeftCell.address

Connaître l'objet cliqué

Sub ShapeAction() msgbox application.Caller & " " & _
activesheet.Shapes(application.Caller).ZOrderPosition
end Sub

Aligner des objets avec une cellule => regardez les instructions suivantes:

activesheet.Buttons("Btn1").top = range("C3").top
activesheet.Buttons("Btn1").Left = range("C3").Left

Insérer un bouton dans toutes les feuilles

exemple 1

Sub AjoutBouton()
Ztcpt = 1
For Each Zaza In Workbooks("Classeur1").sheets

Zaza.Select
Zaza.Buttons.Add(144, 3, 74.25, 25.5).Select
Selection.Name = "MonBout" & Ztcpt
Selection.OnAction = "Test"
Zaza.Shapes("MonBout" & Ztcpt).Select
Selection.Characters.Text = "Test"
With Selection.Characters(Start:=1, Length:=4).Font
.ColorIndex = 55
End With
range("B2").Select
Ztcpt = Ztcpt + 1
Next
End Sub

Exemple 2

Sub BoutonInAllSheet()
Dim Zaza
For Each Zaza In Workbooks("Classeur1").sheets
Zaza.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Left:=61.5, Top:=51, Width:=91.5, Height:=27.75).Select
Next Zaza
End Sub

CommandButton1_MouseMove, Cacher/afficher un label (en guise de légende), lorsque la souris passe sur un bouton

private sub CommandButton1_MouseMove(byval Button _
As Integer, byval Shift As Integer, byval X As _
Single, byval Y As Single)
With Label1
If Not .Visible Then
.Visible = True
End If
End With
End Sub

MULTIPAGE

Pour mettre la 4e page en première position : MultiPage1.Page4.Index = 0

Comment imposer quel page sera la première dans un multipage : Affecter 0 à la propriété value du MultiPage avant d'afficher le
Userform.

with Userform1
.MultiPage1.value = 0
.show
end with

Utiliser l'instruction selectedItem.Index pour récupérer ou déterminer la page courante de ce contrôle multipage.
Par exemple, un contrôle multipage appelé "mpgMain" qui contient deux pages. Sur celles-ci deux contrôles multipages "mpgSub1" et "mpgSub2", qui ont chacun trois pages. Si on veut afficher la seconde page de mpgSub2 à chaque fois que l'utilisateur sélectionne ka première page de mpgMain, on peut utiliser :

Private Sub mpgMain_Change()
if mpgMain.selectedItem.Index = 0 then
mpgSub1.selectedItem.Index = 1
end if
end Sub

AUTRES CONTRÔLES

Contrôle ListView : web