[XL-2016] Problème ouverture userform

1 pièce(s) jointe(s)

Problème ouverture userform

Bonjour a vous tous, j'ai un programme qui fonctionne très bien sur un PC mais ne fonctionne pas sur mon mac, ça bug lorsque j'ouvre un userform.

Est ce que quelqu'un peut m'aider a résoudre mon problème.

Merci

dede869

Bonjour,

est-ce que quelqu'un peut nous montrer le code du userform .... par exemple l'auteur de la discussion ? :aie:

Bonjour voici ou ça bug et je croyais avoir enlevé le mot de passe pour l'ouvrir main non donc le mot de passe pour l'ouvrir est 8320 et mot de passe pour acces au code vba est toto.

merci
Code:

1 2 3 Sub appel_Simple() etape1.Show End Sub

Ouille, c'est soirée cartomancie on dirait

J'imagine que tu as une erreur "Erreur définie par l'application ou l'objet" par exemple ? Ou une autre erreur assez générique qui ne dit pas vraiment ce qui se passe ?

Nous devons voir le code situé dans ton userform :

- la procédure initialise
- la procédure Activate s'il y en a une

car c'est probablement là qu'est le souci ... tu as un bug qui ne permet pas d'afficher le userform, alors il plante et te marque la ligne qui appelait le userform

comme dans X-Files... la vérité est ailleurs

Presque personne n'ouvre les fichiers-joints. Surtout s'ils sont balancés avec la première question. Surtout si ce sont des fichiers de macros.

Bonjour voici le code de complet l'userform1 qui sert a ouvrir d'autre userfrom, celui-ci fonctionne bien.

Code:

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
Private Sub CommandButton1_Click()
UserForm1.Hide
appel_Simple
End Sub
Private Sub CommandButton2_Click()
If MsgBox("VOULEZ-VOUS VRAIMENT ENREGISTRER ET QUITTER?", vbYesNo) = vbYes Then
    Range("B3").Select
    ActiveWorkbook.Save
    Application.Quit
    End If
    End Sub
Private Sub CommandButton3_Click()
UserForm1.Hide
appel_simple4
End Sub
Private Sub CommandButton4_Click()
UserForm1.Hide
appel_Simple3
End Sub
Private Sub CommandButton7_Click()
UserForm1.Hide
  Sheets("TABLEAU").Activate
Range("A1").Select
End Sub
Private Sub CommandButton8_Click()
appel_Simple5
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Click()
End Sub

Voici le code pour l'userform (etape1) qui ne veut pas auvrir code d'erreure "un composante activx ne peut crée un objet"

Code:

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
Dim consulte As Range
Dim i As Byte, k As Byte
Dim Fait As Boolean, Fait2 As Boolean
Dim Derligne As Integer, Li As Integer
Dim Cel As Range
Dim C As Range
Private Sub b_consult_Click()
If Me.TextBox9.Value = "" Then
Exit Sub
End If
Sheets("TABLEAU").Activate
Set consulte = Range([a3], [B65536].End(xlUp)).Find(what:=Me.TextBox9, LookIn:=xlValues, lookat:=xlWhole)
If Not consulte Is Nothing Then
   Me.TextBox1 = consulte.Offset(0, -1).Value 'Nom du travaileur
   Me.TextBox2 = consulte.Offset(0, 1).Value 'Description
   Me.TextBox3 = Format(consulte.Offset(0, 2).Value, FormulaLocal, aaaa - mm - jj) 'Date de la sanction
   Me.TextBox4 = Format(consulte.Offset(0, 3).Value, FormulaLocal, aaaa - mm - jj) 'Date limite pour dépot
   Me.TextBox5 = Format(consulte.Offset(0, 5).Value, FormulaLocal, aaaa - mm - jj) 'Date du dépot du grief
   Me.TextBox6 = Format(consulte.Offset(0, 6).Value, FormulaLocal, aaaa - mm - jj) 'Date limite réponse superviseur
   Me.TextBox7 = Format(consulte.Offset(0, 7).Value, FormulaLocal, aaaa - mm - jj) ' Réponse du superviseur
   Me.TextBox8 = consulte.Offset(0, 18).Value 'Adresse courriel
   Me.ComboBox1 = consulte.Offset(0, 17).Value 'Nom du délégué
Else: MsgBox "Ce code n'existe pas dans la liste."
End If
 
End Sub
Private Sub b_modif_Click()
    Sheets("TABLEAU").Activate
    With consulte
    .Value = Me.TextBox9
    .Offset(0, 0).Value = Me.TextBox9  '# grief
    .Offset(0, -1).Value = Me.TextBox1 'nom
    .Offset(0, 1).Value = Me.TextBox2 'natur du grief
    .Offset(0, 2).Value = Format(Me.TextBox3, FormulaLocal, aaaa - mm - jj) ' Date de la sanction
    .Offset(0, 5).Value = Format(Me.TextBox5, FormulaLocal, aaaa - mm - jj) ' Date dépot grief
    .Offset(0, 7).Value = Format(Me.TextBox7, FormulaLocal, aaaa - mm - jj) 'Date réponse employeur
    .Offset(0, 18).Value = Me.TextBox8 'Adresse courriel
    .Offset(0, 17).Value = Me.ComboBox1 'Nom du délégué responsable
End With
End Sub
Private Sub b_fin_Click()
Unload Me
UserForm1.Show
End Sub
Private Sub b_validation_Click_Click()
'--- Positionnement dans la base
Sheets("TABLEAU").Activate
[B65000].End(xlUp).Offset(1, 0).Select
'--- Doublon
Set result = Range("B2:B10000").Find(what:=Me.TextBox9, LookIn:=xlValues, lookat:=xlWhole)
If Not result Is Nothing Then
   MsgBox "code déjà existant"
   Exit Sub
End If
 '--- Transfert Formulaire dans BD
With ActiveCell
    .Value = Me.TextBox9
    .Offset(0, 0).Value = Me.TextBox9 '# grief
    .Offset(0, -1).Value = Me.TextBox1 'nom
    .Offset(0, 1).Value = Me.TextBox2 'natur du grief
    .Offset(0, 2).Value = Format(Me.TextBox3, FormulaLocal, aaaa - mm - jj) ' Date de la sanction
    .Offset(0, 5).Value = Format(Me.TextBox5, FormulaLocal, aaaa - mm - jj) ' Date dépot grief
    .Offset(0, 7).Value = Format(Me.TextBox7, FormulaLocal, aaaa - mm - jj) 'date réponse employeur
    .Offset(0, 18).Value = Me.TextBox8 'Adresse courriel
    .Offset(0, 17).Value = Me.ComboBox1  'Non de délégué responsable
End With
If Me.TextBox3.Value <> "" Then
If MsgBox("VOULEZ-VOUS CRÉÉ UNE TÂCHE POUR CE GRIEF?", vbYesNo) = vbYes Then
Creer_TacheOutlook
End If
End If
Application.Calculate
'--remise à blanc des zones
Me.TextBox9 = ""
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox6 = ""
Me.TextBox7 = ""
Me.TextBox8 = ""
 
End Sub
Private Sub ComboBox1_Change()
 
End Sub
 
Private Sub Label20_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
  Set mondico = CreateObject("Scripting.Dictionary")
  Set F = Sheets("TABLEAU")
  For Each C In F.Range("A3:A" & F.[A65000].End(xlUp).Row)
    mondico.Item(C.Value) = ""
  Next C
  Me.ComboBox3.List = mondico.keys
End Sub
Private Sub ComboBox3_Change()
  i = 0
  Me.ListBox1.Clear
  Set F = Sheets("TABLEAU")
  For Each C In F.Range("B2:B" & F.[B65000].End(xlUp).Row)
    If C.Offset(0, -1) = Me.ComboBox3 Then
       Me.ListBox1.AddItem
       Me.ListBox1.List(i, 0) = C.Value
       Me.ListBox1.List(i, 1) = C.Offset(0, 1).Value
       i = i + 1
    End If
  Next C
End Sub
Private Sub ListBox1_Click()
Sheets("TABLEAU").Activate
Set consulte = Range([b:c], [B65536].End(xlUp)).Find(what:=Me.ListBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not consulte Is Nothing Then
   Me.TextBox1 = consulte.Offset(0, -1).Value 'Nom du travaileur
   Me.TextBox2 = consulte.Offset(0, 1).Value 'Description
   Me.TextBox3 = Format(consulte.Offset(0, 2).Value, FormulaLocal, aaaa - mm - jj) 'Date de la sanction
   Me.TextBox4 = Format(consulte.Offset(0, 3).Value, FormulaLocal, aaaa - mm - jj) 'Date limite pour dépot
   Me.TextBox5 = Format(consulte.Offset(0, 5).Value, FormulaLocal, aaaa - mm - jj) 'Date du dépot du grief
   Me.TextBox6 = Format(consulte.Offset(0, 6).Value, FormulaLocal, aaaa - mm - jj) 'Date limite réponse superviseur
   Me.TextBox7 = Format(consulte.Offset(0, 7).Value, FormulaLocal, aaaa - mm - jj) ' Réponse du superviseur
   Me.TextBox8 = consulte.Offset(0, 18).Value 'Adresse courriel
   Me.TextBox9 = consulte.Offset(0, 0).Value 'Adresse courriel
   Me.ComboBox1 = consulte.Offset(0, 17).Value 'Nom du délégué
   End If
End Sub
Private Sub CommandButton1_Click()
If Me.TextBox5.Value = "" Then
Exit Sub
End If
Sheets("TABLEAU").Activate
Set consulte = Range([a3], [B65536].End(xlUp)).Find(what:=Me.TextBox9, LookIn:=xlValues, lookat:=xlWhole)
If Me.TextBox8.Value = "" Then
MsgBox ("VOUS DEVEZ INCRIRE UNE ADRESSE COURRIEL!")
Exit Sub
Me.TextBox8.SetFocus
End If
If consulte.Offset(0, 19).Value = "" Then
If MsgBox("VOULEZ-VOUS ENVOYER UN EMAIL?", vbYesNo) = vbYes Then
EnvoiAutomatiqueMail
consulte.Offset(0, 19).Value = Now
End If
End If
End Sub
Private Sub Label17_Click()
End Sub
Private Sub TextBox13_Change()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Label6_Click()
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub TextBox3_enter()
Me.TextBox3.Text = FormCalMini.DateCal
  'pour générer l'événement Enter automatiquement
  'CommandButton1.SetFocus
End Sub
Private Sub TextBox4_Change()
End Sub
Private Sub TextBox5_enter()
Me.TextBox5.Text = FormCalMini.DateCal
  'pour générer l'événement Enter automatiquement
  'CommandButton1.SetFocus
End Sub
Private Sub TextBox7_enter()
Me.TextBox7.Text = FormCalMini.DateCal
  'pour générer l'événement Enter automatiquement
  'CommandButton1.SetFocus
End Sub
Private Sub TextBox8_Change()
End Sub
Sub EnvoiAutomatiqueMail()
  Dim j&
  If OutlookOuvert = False Then j = Shell("Outlook", vbNormalNoFocus)
      Envoi "Bonjour Mr, " & " " & TextBox1.Value & "," & vbLf & vbLf & "Votre grief # " & " " & TextBox9.Value & " " & "-" & TextBox2.Value & "," & " a été déposé le " & " " & " " & TextBox5.Value & "" & " au resourse humaine." & vbLf
      End Sub
Function Envoi(Corps$)
  Dim OutlookApp As Object, signature As String
  Dim OutlookMail As Object
  Set OutlookApp = CreateObject("Outlook.Application")
  Set OutlookMail = OutlookApp.CreateItem(0)
  On Error Resume Next
    With OutlookMail
      .signature = OApp.Session.CurrentUser.Address
      .Subject = "Dépôt de grief au ressource humaine"
      .To = TextBox8.Value
      .CC = Feuil1.[c1] & ";" & Feuil1.[c2]
      .Body = Corps & vbLf & Feuil1.[a3] & vbLf & Feuil1.[a4] & vbLf & Feuil1.[a5] & vbLf & Feuil1.[a6]
      .Display 'pour voir
      '.Send 'pour envoyer
    End With
End Function
Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function
Private Sub UserForm_Click()
End Sub

Merci de m'aidé

dede869