Discussion :

[IronHeavy]

Bonjour à tous,

Souhaitant améliorer l'ergonomie de mes UserForm afin de leur donner un caractère plus "logiciel", j'ai intégré une fonction de mise en page automatique pour un affichage:

- plein écran
- ajusté à la définition de tout pc
- sans barre de titre
-...

Le code s'applique parfaitement à 3 de mes USF mais lorsque je l'applique au 4 ème le message d'erreur suivant survient:

"Erreur de compilation : Variable non définie"

mon ancien code (fonctionnel):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Private Sub UserForm_Activate()
    With Me
        .StartUpPosition = 3
        .Width = Application.Width
        .Height = Application.Height
        .Left = 0
 
         End With
 
With Worksheets(Me.TextBox1.Text).Select
        l = Range(Me.TextBox1.Text & "!r9").CurrentRegion.Rows.Count
         Me.ComboBox1.List = Range(Range(Me.TextBox1.Text & "!r9"), Range(Me.TextBox1.Text & "!r" & l + 1)).Value
        Me.ComboBox1.ListIndex = -1
 
         End With

Mon nouveau code (non fonctionnel):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

Option Explicit
'
'Ce programme donne une form plein écran quelque soient la résolution
'et la taille de l'écran, grâce à l'utilisation des fonctions API.
'
'
'Fonctions API
Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal iditem As Long, ByVal wflags As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function IsIconic Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function IsZoomed Lib "User32" (ByVal hWnd As Long) As Long 'non utilisée ici
Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
                                     (ByVal hWnd As Long, ByVal wMsg As Long, _
                                      ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "User32" ()

'
Private Const SW_MAXIMIZE = 3                   'constantes pour la fonction
Private Const SW_MINIMIZE As Long = 6           'ShowWindow
'
Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style
Private Const WS_MINIMIZEBOX = &H20000          'Style to add a Minimize box on the title bar
Private Const WS_CAPTION As Long = &HC00000     'Style to add a titlebar
'
Private Const SC_MOVE = &HF010                  'constantes
Private Const SC_CLOSE = &HF060                 'pour la fonction
Private Const MF_BYCOMMAND = &H0                'DeleteMenu
'
Private Const WM_NCLBUTTONDOWN = &HA1           'constantes pour
Private Const HTCAPTION = 2                     'déplacement form sans titre
'
Dim hWnd As Long                                'le handle de la form
Dim wInit As Long, hInit As Long                'ses dimensions d'origine
Dim FormInit As Boolean                         'définit l'étape d'initialisation de la form
Dim FormSansTitre As Boolean                    'définit l'étape d'enlèvement du titre
Dim FormST As Boolean                           'definit l'état de la form


'

Private Sub UserForm_Activate()
    ShowWindow hWnd, SW_MAXIMIZE   'on veut maximiser la form au démarrage,
                                    
With Worksheets(Me.TextBox1.Text).Select
        l = Range(Me.TextBox1.Text & "!r9").CurrentRegion.Rows.Count
         Me.ComboBox1.List = Range(Range(Me.TextBox1.Text & "!r9"), Range(Me.TextBox1.Text & "!r" & l + 1)).Value
        Me.ComboBox1.ListIndex = -1
        
         End With       
End Sub

Private Sub UserForm_Initialize()
    Dim iStyle As Long, hMenu As Long
    hWnd = FindWindow(vbNullString, Me.Caption) 'le handle de la form
    hMenu = GetSystemMenu(hWnd, 0)              'le handle du system menu
    iStyle = GetWindowLong(hWnd, GWL_STYLE)     'trouve le style du system menu
    iStyle = iStyle Or WS_MINIMIZEBOX           'ajoute le bouton mimimise
    SetWindowLong hWnd, GWL_STYLE, iStyle       'applique le nouveau style
    DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND    'désactive le bouton supprime
    wInit = Me.Width: hInit = Me.Height
    FormInit = True
    FormSansTitre = True
    iStyle = GetWindowLong(hWnd, GWL_STYLE)     'trouve le style du system menu
    iStyle = iStyle And Not WS_CAPTION          'on ne veut pas de titre
    SetWindowLong hWnd, GWL_STYLE, iStyle       'applique le nouveau style
    DrawMenuBar hWnd
    FormSansTitre = False
    FormST = True
   
End Sub

Private Sub UserForm_Resize()
    Dim RW As Single, RH As Single
    If IsIconic(hWnd) <> 0 Then Exit Sub    'la form est en icône:pas de redimensionnements!
    If FormInit = False Then Exit Sub       'on ne doit exécuter les redimensionnements des contrôles qu'une fois au départ!
    If FormSansTitre = True Then Exit Sub   'ne pas exécuter le resize au moment où on enlève le titre...
    'rapports d'agrandissement
    RW = Me.Width / wInit: RH = Me.Height / hInit
    'redimensionnement et replacement de l'ensemble des contrôles voulus en fonction de l'écran
    Dim Ctl As MSForms.Control
    For Each Ctl In Me.Controls
        'on a mis un tag pour les contrôles que l'on ne veut pas redimensionner
        If Ctl.Tag = "" Then Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
        If Not TypeOf Ctl Is Image Then     'ajouter si besoin les autres contrôles n'ayant pas de police
            Ctl.Font.Size = Round(Ctl.Font.Size * RH)   'redim des polices
        End If
    Next
   
    
End Sub

Ou dois-je insérer la partie de code HS? , devrais je la réécrire? le cas échéant, où et comment déclarer la variable manquante?

Merci d'avance!

[Ben_L]

Bonjour,

Dans UserForm_Activate, ajouter la ligne suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim l As Long

Je n'ai pas vérifié si d'autres erreurs sont à corriger.

Cordialement

[IronHeavy]

Bonjour Ben_L,

Déclarer la variable L comme nombre entier a fonctionné, je te remercie...

Je n'avais pas repéré que le nouveau code intégrait une "Option Explicit" me forçait à déclarer toutes mes variables!

Sur un autre Userform, la variable qui coince est du type Sheet:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each Sh In Sheets

Comment dois je la déclarer?

Edit:

Trouvé! ... As Object,

nouveaux message d'erreur résolus par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim MonDico As Object
Dim bd As Object
Dim i As Long

En revanche, maintenant il me demande: "Tableau Attendu" à l'argument:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For i = LBound(bd) To UBound(bd)

Que faire à ce stade?

[Ben_L]

La définition "As Object" est à réserver aux cas où le type d'objet est inconnu.
Pour votre variable Sh, vous pouvez utiliser :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Sh As Worksheet

Pour MonDico, à supposer qu'il s'agisse bien d'un dictionnaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim MonDico As Scripting.Dictionary

Et pour un tableau, plusieurs façons de faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim tb As Variant

fonctionnera toujours, mais consommera probablement un peu plus de mémoire qu'une définition plus précise du type :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim tb() As String   'ce code ne fonctionnera que si vous ne stockez que des String dans le tableau

[IronHeavy]

Oui, en effet, je retravaille sur la portion de code que vous m'avez suggéré la semaine dernière:

Je m'en suis sorti en tâtonnant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub ComboBox1_Click()
 
Dim f As Object
Dim MonDico As Object
Dim bd As Variant
Dim i As Long
Dim temp As Variant
 
 
Me.TextBox1 = ComboBox1
Me.ListBox1.Clear
 
Set f = Sheets(Me.TextBox1.Text)
  Set MonDico = CreateObject("Scripting.Dictionary")
  bd = f.Range("F9:F" & f.[F65000].End(xlUp).Row)  ' tableau bd(n,1) pour rapidité
    For i = LBound(bd) To UBound(bd)
   If bd(i, 1) <> "" Then MonDico(bd(i, 1)) = ""
  Next i
  Me.ListBox1.List = MonDico.keys
 
 '--avec tri
  temp = MonDico.keys
  Call Tri(temp, LBound(temp), UBound(temp))
  Me.ListBox1.List = temp
 
temp = Array(Me.Image1, Me.Image2, Me.Image3, Me.Image4, Me.Image5, Me.Image6, Me.Image7, Me.Image8, Me.Image9, Me.Image10, Me.Image11, Me.Image12, Me.Image13, Me.Image14, Me.Image15, Me.Image16, Me.Image17, Me.Image18, Me.Image19, Me.Image20, Me.Image21, Me.Image22)
With Me.ListBox1
    For i = 0 To .ListCount - 1
            temp(i).Picture = Controls(.List(i, 0)).Picture
    Next i
    For i = .ListCount To UBound(temp)
        temp(i).Picture = LoadPicture("")
    Next i
End With
 
temp = Array(Me.Label1, Me.Label2, Me.Label3, Me.Label4, Me.Label5, Me.Label6, Me.Label7, Me.Label8, Me.Label9, Me.Label10, Me.Label11, Me.Label12, Me.Label13, Me.Label14, Me.Label5, Me.Label16, Me.Label17, Me.Label18, Me.Label19, Me.Label20, Me.Label21, Me.Label22)
With Me.ListBox1
    For i = 0 To .ListCount - 1
            temp(i).Caption = Controls(.List(i, 0)).Name
    Next i
    For i = .ListCount To UBound(temp)
        temp(i).Caption = ""
    Next i
End With
 
 
End Sub

Je continue à détricoter mes USF et à déclarer les variables au petit bonheur...

[Ben_L]

Lorsque vous souhaitez utiliser les valeurs d'une plage pour remplir un tableau (comme à la ligne 15 de votre code), il est préférable de faire appel à la propriété Value2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

bd = f.Range(f.Cells(9, 6), f.Cells(f.Rows.Count, 6).End(xlUp)).Value2