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 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250
|
Option Explicit ' Version du 2 juillet 2013
Private Usf As Object
Private Legende As Object
Private Saisie As Object
Private mF_W As String
Private mNom_USF As String
Private mCOMPTEUR_L As Integer
Private mCOMPTEUR_C As Integer
Public Property Get Nom_USF() As String: Nom_USF = mNom_USF: End Property
Public Property Let Nom_USF(ByVal Nom_USF As String): mNom_USF = Nom_USF: End Property
Public Property Get F_W() As String: F_W = mF_W: End Property
Public Property Let F_W(ByVal F_W As String): mF_W = F_W: End Property
Public Property Get COMPTEUR_L() As Integer: COMPTEUR_L = mCOMPTEUR_L: End Property
Public Property Let COMPTEUR_L(ByVal COMPTEUR_L As Integer): mCOMPTEUR_L = COMPTEUR_L: End Property
Public Property Get COMPTEUR_C() As Integer: COMPTEUR_C = mCOMPTEUR_C: End Property
Public Property Let COMPTEUR_C(ByVal COMPTEUR_C As Integer): mCOMPTEUR_C = COMPTEUR_C: End Property
Public Sub Class_Initialize()
MsgBox "mouchard INIT LA CLASSE"
F_W = "W"
Nom_USF = "TELLE_USF"
COMPTEUR_L = derLIGNE
COMPTEUR_C = derCOL
End Sub
Sub Appel_USERFORM_V2()
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
Dim X As Object: Set X = CREATION_UserForm
'AFFICHE L'USER FORM
With ws
.Activate
X.Show
End With
'DESTRUCTION DE L'USER FORM A SA CLOTURE CAR LA MACRO A TJRS LA MAIN
ThisWorkbook.VBProject.VBComponents.Remove Usf
Set Usf = Nothing
MsgBox "L'USF est détruite ! "
Set X = Nothing
Set ws = Nothing
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
Private Function CREATION_UserForm() As Object
'DCL les Variables locales
Dim j As Integer
'DCL les objets
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
ReDim str_BlaBla(1 To COMPTEUR_C) As String
Set Usf = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With Usf
.Name = Nom_USF
.Properties("Caption") = "FAIRE UNE SAISIE EN TABLE : " & F_W
.Properties("Width") = 300
.Properties("Height") = 200
.Properties("StartUpPosition") = 1
End With
'*****************************************************************
' AUTO ECRITURE DES LIGNES DE CODES ASSOCIEES
'*****************************************************************
With Usf.CodeModule
j = .CountOfLines
'********************** CODE DU CMD VALIDER ********************
.InsertLines j + 1, "Sub VALID_Click():dim MonTEXT as string:MonTEXT=""ENTRE DANS VALIDER """
.InsertLines j + 2, "Msgbox MonTEXT"
.InsertLines j + 3, "Dim U as O_USER_FORM"
.InsertLines j + 4, "Set U = New O_USER_FORM"
.InsertLines j + 5, "Call U.VALIDER"
.InsertLines j + 6, "Me.Hide"
.InsertLines j + 7, "End Sub"
'********************** CODE DU CMD QUITTER ********************
.InsertLines j + 8, "Sub QUITT_Click():dim MonTEXT as string:MonTEXT=""ENTRE DANS QUITTER """
.InsertLines j + 9, "Msgbox MonTEXT"
.InsertLines j + 10, "Me.Hide"
.InsertLines j + 11, "End Sub"
End With
'*****************************************************************
' GESTION DES CMD DE BASE
'*****************************************************************
Call Faire_CMD_VALID
Call Faire_CMD_QUITTER
'***************** BOUCLE SUR LES LABELS ET TEXT BOX ***********
Dim i As Integer
For i = 1 To COMPTEUR_C
str_BlaBla(i) = ws.Cells(1, i).Value
Call Constructeur_Label(i, str_BlaBla(i))
If i > 1 Then
Call Constructeur_SAISIE(i, str_BlaBla(i))
Else
Call Faire_NUM
End If
Next i
'******************************************************************
VBA.UserForms.Add (Usf.Name)
Set CREATION_UserForm = UserForms(UserForms.Count - 1)
End Function
Public Sub VALIDER()
Dim MonTEXT As String: MonTEXT = "HELLO IN VALIDER"
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
Dim i As Integer: i = 1
Dim Max_Col As Integer: Max_Col = derCOL
Dim Num_Ligne As Integer: Num_Ligne = derLIGNE + 1
ReDim TabloSAISIES(1 To Max_Col)
Dim Nom_TBX As String: Nom_TBX = "TextBox"
Dim F As Control
Dim O As UserForm: Set O = TELLE_USF
For Each F In TELLE_USF.Controls
If F.Name = Nom_TBX & i Then
'**** MOUCHARD SUR TEXTBOX ****
MsgBox "F.Name = " & F.Name & ", F.Value = " & F.Value
'******************************
TabloSAISIES(i) = F.Value
i = i + 1
End If
Next F
With ws
.Activate
For i = 1 To Max_Col
.Cells(Num_Ligne, i + 1).Value = TabloSAISIES(i)
Next i
End With
MsgBox "Sort de VALIDER"
Set ws = Nothing
Set O = Nothing
End Sub
'********************************************************************
' GENERE LES OBJETS DE L'INTERFACE
'********************************************************************
'CMD VALIDATION DES SAISIES
Private Function Faire_CMD_VALID()
Set Legende = Usf.Designer.Controls.Add("Forms.CommandButton.1")
With Legende
.Name = "VALID"
.Width = 60
.Left = 220
.Top = 1
.Height = 20
.Caption = "VALIDER"
End With
Set Legende = Nothing
End Function
'CMD QUITTER DE LA BD SAISIE
Private Function Faire_CMD_QUITTER()
Set Legende = Usf.Designer.Controls.Add("Forms.CommandButton.1")
With Legende
.Name = "QUITT"
.Width = 60
.Left = 100
.Top = 1
.Height = 20
.Caption = "QUITTER"
End With
Set Legende = Nothing
End Function
'INTITULES DES CHAMPS DE TABLE
Private Function Constructeur_Label(Indice As Integer, str_BlaBla As String)
Set Legende = Usf.Designer.Controls.Add("Forms.Label.1")
With Legende
.Width = 100
.Left = 5
.Top = 1 + (20 * Indice - 1)
.Height = 20
.Caption = "Ma legende = " & str_BlaBla
End With
Set Legende = Nothing
End Function
'AFFICHE SOUS FORME DE LABEL, L'INDEX DE LA NOUVELLE SAISIE
Private Function Faire_NUM()
Set Legende = Usf.Designer.Controls.Add("Forms.Label.1")
With Legende
.Width = 100
.Left = 100
.Top = 20
.Height = 20
.Caption = COMPTEUR_L
End With
Set Legende = Nothing
End Function
'TEXT BOX DES SAISIES UTILISATEUR
Private Function Constructeur_SAISIE(Indice As Integer, str_BlaBla As String)
Set Saisie = Usf.Designer.Controls.Add("Forms.TextBox.1")
With Saisie
.Width = 100
.Left = 100
.Top = 1 + (20 * Indice - 1)
.Height = 15
End With
Set Saisie = Nothing
End Function
'********************************************************************
' GENERE LES INDICES DE FIN DE LIGNE ET DE COLONNE
'********************************************************************
Private Function derLIGNE() As Integer
Dim NbLignes As Integer
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
With ws
.Activate
NbLignes = ActiveSheet.UsedRange.Rows.Count
End With
Set ws = Nothing
derLIGNE = NbLignes
'MsgBox " NbLignes = " & NbLignes
End Function
Private Function derCOL() As Integer
Dim NbCol As Integer
Dim ws As Worksheet: Set ws = Application.Sheets(F_W)
With ws
.Activate
NbCol = ActiveSheet.UsedRange.Columns.Count
End With
Set ws = Nothing
derCOL = NbCol
'MsgBox "NbCol = " & NbCol
End Function |
Partager