USERFORM et CODE EXECUTABLE
stephbret56
Messages postés
195
Statut
Membre
-
stephbret56 Messages postés 195 Statut Membre -
stephbret56 Messages postés 195 Statut Membre -
Bonjour,
Suite a la création d'un userform j'aimerai lui associer du code exécutable comment puis je paramétré ce userform
A savoir que le userform seul fonctionne bien ainsi que le code exécutable
Je vous mets ma procédure qui ne fonctionne pas lorsque je met les deux ensembles:
' Declaration de mon UserForm
'
'
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
'Saisie de la date
End Sub
Private Sub CommandButton1_Click()
Dim Flag As Boolean
Dim I As Byte
'Résultat de la Saisie date sous la forme JJMMAA
'Et du choix du fichier
For I = 1 To 2
If Me.Controls("OptionButton" & I) Then Flag = True
Next I
If Not Flag Then
MsgBox "Veuillez sélectionner un fichier!"
Exit Sub
End If
Variable1 = TextBox1
Variable2 = IIf(Me.OptionButton1, Me.OptionButton1.Caption, Me.OptionButton2.Caption)
End Sub
Private Sub UserForm_Click()
End Sub
'
'
' Fin de declaration de mon UserForm
'
'
'
'
' Declaration de mon code executable
'
'
Option Explicit
Dim Fso As FileSystemObject
'DETAIL DE L'ADRESS
Type Export_csv
Colonne_A As String
Colonne_B As String
Colonne_C As String
Colonne_D As String
Colonne_E As String
Colonne_F As String
Colonne_G As String
Colonne_H As String
Colonne_I As String
Colonne_J As String
Colonne_K As String
Colonne_L As String
Colonne_M As String
Colonne_N As String
Colonne_O As String
Colonne_P As String
Colonne_Q As String
Colonne_R As String
End Type
'DETAIL DU FICHIER
Public Detail_Export_csv As Export_csv
'EMPLACEMENT DU FICHIER A CREER
Public Emplacement_Fichier As String
Private Function Ecriture_Entete() As Boolean
Set Fso = New FileSystemObject
Emplacement_Fichier = "C:\monrep\monfic.csv"
On Error Resume Next
If Fso.FileExists(Emplacement_Fichier) = True Then
Fso.DeleteFile Emplacement_Fichier, True
End If
On Error GoTo 0
Set Fso = Nothing
On Error Resume Next
Open Emplacement_Fichier For Output As #1
Select Case Err.Number
Case Is = 0
Ecriture_Entete = True
Case 71
MsgBox "Le support n'est pas accessible.", vbExclamation, "Message"
Ecriture_Entete = False
Case Else
MsgBox Err.Description, vbExclamation, "Message"
Ecriture_Entete = False
End Select
On Error GoTo 0
End Function
Private Function Ecriture_Detail(Colonne_A As String, Colonne_B As String, Colonne_C As String, Colonne_D As String, Colonne_E As String, Colonne_F As String, Colonne_G As String, Colonne_H As String, Colonne_I As String, Colonne_J As String, Colonne_K As String, Colonne_L As String, Colonne_M As String, Colonne_N As String, Colonne_O As String, Colonne_P As String, Colonne_Q As String, Colonne_R As String) As Boolean
Ecriture_Detail = False
Detail_Export_csv.Colonne_A = Colonne_A
Detail_Export_csv.Colonne_B = Colonne_B
Detail_Export_csv.Colonne_C = Colonne_C
Detail_Export_csv.Colonne_D = Colonne_D
Detail_Export_csv.Colonne_E = Colonne_E
Detail_Export_csv.Colonne_F = Colonne_F
Detail_Export_csv.Colonne_G = Colonne_G
Detail_Export_csv.Colonne_H = Colonne_H
Detail_Export_csv.Colonne_I = Colonne_I
Detail_Export_csv.Colonne_J = Colonne_J
Detail_Export_csv.Colonne_K = Colonne_K
Detail_Export_csv.Colonne_L = Colonne_L
Detail_Export_csv.Colonne_M = Colonne_M
Detail_Export_csv.Colonne_N = Colonne_N
Detail_Export_csv.Colonne_O = Colonne_O
Detail_Export_csv.Colonne_P = Colonne_P
Detail_Export_csv.Colonne_Q = Colonne_Q
Detail_Export_csv.Colonne_R = Colonne_R
On Error Resume Next
Print #1, Detail_Export_csv.Colonne_A & ";" & Detail_Export_csv.Colonne_B & ";" & Detail_Export_csv.Colonne_C & ";" & Detail_Export_csv.Colonne_D & ";" & Detail_Export_csv.Colonne_E & ";" & Detail_Export_csv.Colonne_F & ";" & Detail_Export_csv.Colonne_G & ";" & Detail_Export_csv.Colonne_H & ";" & Detail_Export_csv.Colonne_I & ";" & Detail_Export_csv.Colonne_J & ";" & Detail_Export_csv.Colonne_K & ";" & Detail_Export_csv.Colonne_L & ";" & Detail_Export_csv.Colonne_M & ";" & Detail_Export_csv.Colonne_N & ";" & Detail_Export_csv.Colonne_O & ";" & Detail_Export_csv.Colonne_P & ";" & Detail_Export_csv.Colonne_Q & ";" & Detail_Export_csv.Colonne_R
If Err.Number = 0 Then
Ecriture_Detail = True
Else
Ecriture_Detail = False
End If
On Error GoTo 0
End Function
Private Sub Ecriture_Fin()
Close #1
End Sub
Public Sub Formatage_Cellule_10_Caractères()
Call Ecriture_Entete
Dim Colonne_A As String
Dim Colonne_B As String
Dim Colonne_C As String
Dim Colonne_D As String
Dim Colonne_E As String
Dim Colonne_F As String
Dim Colonne_G As String
Dim Colonne_H As String
Dim Colonne_I As String
Dim Colonne_J As String
Dim Colonne_K As String
Dim Colonne_L As String
Dim Colonne_M As String
Dim Colonne_N As String
Dim Colonne_O As String
Dim Colonne_P As String
Dim Colonne_Q As String
Dim Colonne_R As String
Dim I As Integer
Dim j As Integer
I = 1
Do Until ActiveSheet.Cells(I, 1).Value = ""
For j = 1 To 18
Select Case j
Case 1
Colonne_A = ActiveSheet.Cells(I, j).Value
Case 2
Colonne_B = ActiveSheet.Cells(I, j).Value
Case 3
Colonne_C = String(10 - Len(ActiveSheet.Cells(I, j).Value), "0") & ActiveSheet.Cells(I, j).Value
Case 4
Colonne_D = ActiveSheet.Cells(I, j).Value
Case 5
Colonne_E = ActiveSheet.Cells(I, j).Value
Case 6
Colonne_F = ActiveSheet.Cells(I, j).Value
Case 7
Colonne_G = ActiveSheet.Cells(I, j).Value
Case 8
Colonne_H = ActiveSheet.Cells(I, j).Value
Case 9
Colonne_I = ActiveSheet.Cells(I, j).Value
Case 10
Colonne_J = ActiveSheet.Cells(I, j).Value
Case 11
Colonne_K = ActiveSheet.Cells(I, j).Value
Case 12
Colonne_L = ActiveSheet.Cells(I, j).Value
Case 13
Colonne_M = ActiveSheet.Cells(I, j).Value
Case 14
Colonne_N = ActiveSheet.Cells(I, j).Value
Case 15
Colonne_O = ActiveSheet.Cells(I, j).Value
Case 16
Colonne_P = ActiveSheet.Cells(I, j).Value
Case 17
Colonne_Q = ActiveSheet.Cells(I, j).Value
Case 18
Colonne_R = ActiveSheet.Cells(I, j).Value
End Select
Next j
If Ecriture_Detail(Colonne_A, Colonne_B, Colonne_C, Colonne_D, Colonne_E, Colonne_F, Colonne_G, Colonne_H, Colonne_I, Colonne_J, Colonne_K, Colonne_L, Colonne_M, Colonne_N, Colonne_O, Colonne_P, Colonne_Q, Colonne_R) = False Then
Exit Do
End If
I = I + 1
Loop
Call Ecriture_Fin
End Sub
Suite a la création d'un userform j'aimerai lui associer du code exécutable comment puis je paramétré ce userform
A savoir que le userform seul fonctionne bien ainsi que le code exécutable
Je vous mets ma procédure qui ne fonctionne pas lorsque je met les deux ensembles:
' Declaration de mon UserForm
'
'
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub TextBox1_Change()
'Saisie de la date
End Sub
Private Sub CommandButton1_Click()
Dim Flag As Boolean
Dim I As Byte
'Résultat de la Saisie date sous la forme JJMMAA
'Et du choix du fichier
For I = 1 To 2
If Me.Controls("OptionButton" & I) Then Flag = True
Next I
If Not Flag Then
MsgBox "Veuillez sélectionner un fichier!"
Exit Sub
End If
Variable1 = TextBox1
Variable2 = IIf(Me.OptionButton1, Me.OptionButton1.Caption, Me.OptionButton2.Caption)
End Sub
Private Sub UserForm_Click()
End Sub
'
'
' Fin de declaration de mon UserForm
'
'
'
'
' Declaration de mon code executable
'
'
Option Explicit
Dim Fso As FileSystemObject
'DETAIL DE L'ADRESS
Type Export_csv
Colonne_A As String
Colonne_B As String
Colonne_C As String
Colonne_D As String
Colonne_E As String
Colonne_F As String
Colonne_G As String
Colonne_H As String
Colonne_I As String
Colonne_J As String
Colonne_K As String
Colonne_L As String
Colonne_M As String
Colonne_N As String
Colonne_O As String
Colonne_P As String
Colonne_Q As String
Colonne_R As String
End Type
'DETAIL DU FICHIER
Public Detail_Export_csv As Export_csv
'EMPLACEMENT DU FICHIER A CREER
Public Emplacement_Fichier As String
Private Function Ecriture_Entete() As Boolean
Set Fso = New FileSystemObject
Emplacement_Fichier = "C:\monrep\monfic.csv"
On Error Resume Next
If Fso.FileExists(Emplacement_Fichier) = True Then
Fso.DeleteFile Emplacement_Fichier, True
End If
On Error GoTo 0
Set Fso = Nothing
On Error Resume Next
Open Emplacement_Fichier For Output As #1
Select Case Err.Number
Case Is = 0
Ecriture_Entete = True
Case 71
MsgBox "Le support n'est pas accessible.", vbExclamation, "Message"
Ecriture_Entete = False
Case Else
MsgBox Err.Description, vbExclamation, "Message"
Ecriture_Entete = False
End Select
On Error GoTo 0
End Function
Private Function Ecriture_Detail(Colonne_A As String, Colonne_B As String, Colonne_C As String, Colonne_D As String, Colonne_E As String, Colonne_F As String, Colonne_G As String, Colonne_H As String, Colonne_I As String, Colonne_J As String, Colonne_K As String, Colonne_L As String, Colonne_M As String, Colonne_N As String, Colonne_O As String, Colonne_P As String, Colonne_Q As String, Colonne_R As String) As Boolean
Ecriture_Detail = False
Detail_Export_csv.Colonne_A = Colonne_A
Detail_Export_csv.Colonne_B = Colonne_B
Detail_Export_csv.Colonne_C = Colonne_C
Detail_Export_csv.Colonne_D = Colonne_D
Detail_Export_csv.Colonne_E = Colonne_E
Detail_Export_csv.Colonne_F = Colonne_F
Detail_Export_csv.Colonne_G = Colonne_G
Detail_Export_csv.Colonne_H = Colonne_H
Detail_Export_csv.Colonne_I = Colonne_I
Detail_Export_csv.Colonne_J = Colonne_J
Detail_Export_csv.Colonne_K = Colonne_K
Detail_Export_csv.Colonne_L = Colonne_L
Detail_Export_csv.Colonne_M = Colonne_M
Detail_Export_csv.Colonne_N = Colonne_N
Detail_Export_csv.Colonne_O = Colonne_O
Detail_Export_csv.Colonne_P = Colonne_P
Detail_Export_csv.Colonne_Q = Colonne_Q
Detail_Export_csv.Colonne_R = Colonne_R
On Error Resume Next
Print #1, Detail_Export_csv.Colonne_A & ";" & Detail_Export_csv.Colonne_B & ";" & Detail_Export_csv.Colonne_C & ";" & Detail_Export_csv.Colonne_D & ";" & Detail_Export_csv.Colonne_E & ";" & Detail_Export_csv.Colonne_F & ";" & Detail_Export_csv.Colonne_G & ";" & Detail_Export_csv.Colonne_H & ";" & Detail_Export_csv.Colonne_I & ";" & Detail_Export_csv.Colonne_J & ";" & Detail_Export_csv.Colonne_K & ";" & Detail_Export_csv.Colonne_L & ";" & Detail_Export_csv.Colonne_M & ";" & Detail_Export_csv.Colonne_N & ";" & Detail_Export_csv.Colonne_O & ";" & Detail_Export_csv.Colonne_P & ";" & Detail_Export_csv.Colonne_Q & ";" & Detail_Export_csv.Colonne_R
If Err.Number = 0 Then
Ecriture_Detail = True
Else
Ecriture_Detail = False
End If
On Error GoTo 0
End Function
Private Sub Ecriture_Fin()
Close #1
End Sub
Public Sub Formatage_Cellule_10_Caractères()
Call Ecriture_Entete
Dim Colonne_A As String
Dim Colonne_B As String
Dim Colonne_C As String
Dim Colonne_D As String
Dim Colonne_E As String
Dim Colonne_F As String
Dim Colonne_G As String
Dim Colonne_H As String
Dim Colonne_I As String
Dim Colonne_J As String
Dim Colonne_K As String
Dim Colonne_L As String
Dim Colonne_M As String
Dim Colonne_N As String
Dim Colonne_O As String
Dim Colonne_P As String
Dim Colonne_Q As String
Dim Colonne_R As String
Dim I As Integer
Dim j As Integer
I = 1
Do Until ActiveSheet.Cells(I, 1).Value = ""
For j = 1 To 18
Select Case j
Case 1
Colonne_A = ActiveSheet.Cells(I, j).Value
Case 2
Colonne_B = ActiveSheet.Cells(I, j).Value
Case 3
Colonne_C = String(10 - Len(ActiveSheet.Cells(I, j).Value), "0") & ActiveSheet.Cells(I, j).Value
Case 4
Colonne_D = ActiveSheet.Cells(I, j).Value
Case 5
Colonne_E = ActiveSheet.Cells(I, j).Value
Case 6
Colonne_F = ActiveSheet.Cells(I, j).Value
Case 7
Colonne_G = ActiveSheet.Cells(I, j).Value
Case 8
Colonne_H = ActiveSheet.Cells(I, j).Value
Case 9
Colonne_I = ActiveSheet.Cells(I, j).Value
Case 10
Colonne_J = ActiveSheet.Cells(I, j).Value
Case 11
Colonne_K = ActiveSheet.Cells(I, j).Value
Case 12
Colonne_L = ActiveSheet.Cells(I, j).Value
Case 13
Colonne_M = ActiveSheet.Cells(I, j).Value
Case 14
Colonne_N = ActiveSheet.Cells(I, j).Value
Case 15
Colonne_O = ActiveSheet.Cells(I, j).Value
Case 16
Colonne_P = ActiveSheet.Cells(I, j).Value
Case 17
Colonne_Q = ActiveSheet.Cells(I, j).Value
Case 18
Colonne_R = ActiveSheet.Cells(I, j).Value
End Select
Next j
If Ecriture_Detail(Colonne_A, Colonne_B, Colonne_C, Colonne_D, Colonne_E, Colonne_F, Colonne_G, Colonne_H, Colonne_I, Colonne_J, Colonne_K, Colonne_L, Colonne_M, Colonne_N, Colonne_O, Colonne_P, Colonne_Q, Colonne_R) = False Then
Exit Do
End If
I = I + 1
Loop
Call Ecriture_Fin
End Sub
A voir également:
- USERFORM et CODE EXECUTABLE
- Code ascii - Guide
- Code puk bloqué - Guide
- Comment déverrouiller un téléphone quand on a oublié le code - Guide
- Code activation windows 10 - Guide
- Scanner qr code pc - Guide
4 réponses
bonsoir,
qu'est que t'entends par paramétrer? ce sont des objets répondant à des événements. tu cliques droit dessus puis tu choisis "Code", la page de codes exécutable du userform va apparaître et t'auras plus programmer les événements qui t'intéressent.
salut.
qu'est que t'entends par paramétrer? ce sont des objets répondant à des événements. tu cliques droit dessus puis tu choisis "Code", la page de codes exécutable du userform va apparaître et t'auras plus programmer les événements qui t'intéressent.
salut.
Bonjour,
A l'origine j'ai deux procédures, la procédure UserForm et une autre que j'appelle mon code exécutable
La 1ere (Userform) démarre du commentaire suivant:
' Declaration de mon UserForm
Jusqu'au commentaire :
' Fin de declaration de mon UserForm
La 2eme (code exécutable) démarre du commentaire :
' Declaration de mon code executable
Jusqu'à la fin du code de l'exemple transmis lors de mon 1er message
Le but c'est de faire fonctionner l'ensemble dans une meme procedure (la 1er et la 2eme)
Aujourd'hui j'arrive à faire fonctionner chaque procedure mais séparément
comment assembler les deux dans une seule procédure
A l'origine j'ai deux procédures, la procédure UserForm et une autre que j'appelle mon code exécutable
La 1ere (Userform) démarre du commentaire suivant:
' Declaration de mon UserForm
Jusqu'au commentaire :
' Fin de declaration de mon UserForm
La 2eme (code exécutable) démarre du commentaire :
' Declaration de mon code executable
Jusqu'à la fin du code de l'exemple transmis lors de mon 1er message
Le but c'est de faire fonctionner l'ensemble dans une meme procedure (la 1er et la 2eme)
Aujourd'hui j'arrive à faire fonctionner chaque procedure mais séparément
comment assembler les deux dans une seule procédure