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

Configuration: excel 2003
XP Pro