Erreur automation

hiautoliv · 9 Octobre 2014

Bonjour,

J'ai un souci avec le fichier joint. J'utilise des Userform pour faire la gestion des outils de controle de la socièté, et les gens font la mise à jour en renseignant les différents textbox. Nous sommes passés en Office 2013 en début de semaine, et depuis je récupère une erreur automation quand j'essaye de modifier un enregistrement. J'ai rééssayé sous 2010, et le souci disparait. Je suppose donc que Microsoft a changé quelque chose dans sa gestion des évènements, mais tout ce que j'ai pu essayé n'a pas donné satisfaction. De temps en temps, je trouve une solution qui semble fonctionner, mais en enchainant les actions dans un ordre différent, je retrouve mon erreur.
En résumé, une action sur la mise à jour d'une date d'étalonnage, suivi d'une modification de la textbox d'identification de l'outil (Taper Vi..., car avec INS- il n'y a pas d'erreur), on a une erreur. Il semble donc que pour que ça ne fonctionne pas, il faille taper un deuxième caractère qui soit différent de celui présélectionné.
Si quelqu'un a une idée sur l'origine de ce problème et le moyen d'y remédier, je suis preneur.
Merci à tous ceux qui donneront un peu de leur temps

Paf · 9 Octobre 2014

Re : Erreur automation

Bonjour

J'ai un souci avec le fichier joint

heu .... ben, nous aussi !

A+

hiautoliv · 10 Octobre 2014

Re : Erreur automation

Désolé pour l'erreur, mais je suis nouveau sur le forum et j'ai fait une fausse manip. Bien entendu, le fichier est trop lourd pour pouvoir être joint. Je vais donc essayer de faire passer les macros :
Dans chaque feuille j'ai :
Private Sub Worksheet_Deactivate()
If menu_hide And Not macfeuil Then
menu_hide = False
Menu.Show 0
End If
End Sub

il y a deux userform principaux menu et majdatetal qui contiennent :
pour menu
Option Explicit

Private Sub administration_Click()
If ActiveWorkbook.ReadOnly Then
MsgBox "Fonction indisponible en lecture seule"
Else
administrator.Show
End If
End Sub
Private Sub etalon_depass_Click()
Dim dern As Integer
Dim i, j As Integer
Dim date_etal As Date
Dim lgn As Integer
Dim deb As Integer

mois.Show
If Annul Then
Exit Sub
End If
macfeuil = True
'Worksheets("instru").Activate
unprotec
Select Case mois_etal
Case "janvier"
If Month(Date) > 1 Then date_etal = "31/01/" & Year(Date) + 1 Else date_etal = "31/01/" & Year(Date)
Case "février"
If Year(Date) Mod 4 = 0 Then
If Month(Date) > 2 Then date_etal = "28/02/" & Year(Date) + 1 Else date_etal = "29/02/" & Year(Date)
Else
If Year(Date) Mod 4 = 3 Then
If Month(Date) > 2 Then date_etal = "29/02/" & Year(Date) + 1 Else date_etal = "28/02/" & Year(Date)
Else
If Month(Date) > 2 Then date_etal = "28/02/" & Year(Date) + 1 Else date_etal = "28/02/" & Year(Date)
End If
End If
Case "mars"
If Month(Date) > 3 Then date_etal = "31/03/" & Year(Date) + 1 Else date_etal = "31/03/" & Year(Date)
Case "avril"
If Month(Date) > 4 Then date_etal = "30/04/" & Year(Date) + 1 Else date_etal = "30/04/" & Year(Date)
Case "mai"
If Month(Date) > 5 Then date_etal = "31/05/" & Year(Date) + 1 Else date_etal = "31/05/" & Year(Date)
Case "juin"
If Month(Date) > 6 Then date_etal = "30/06/" & Year(Date) + 1 Else date_etal = "30/06/" & Year(Date)
Case "juillet"
If Month(Date) > 7 Then date_etal = "31/07/" & Year(Date) + 1 Else date_etal = "31/07/" & Year(Date)
Case "août"
If Month(Date) > 8 Then date_etal = "31/08/" & Year(Date) + 1 Else date_etal = "31/08/" & Year(Date)
Case "septembre"
If Month(Date) > 9 Then date_etal = "30/09/" & Year(Date) + 1 Else date_etal = "30/09/" & Year(Date)
Case "octobre"
If Month(Date) > 10 Then date_etal = "31/10/" & Year(Date) + 1 Else date_etal = "31/10/" & Year(Date)
Case "novembre"
If Month(Date) > 11 Then date_etal = "30/11/" & Year(Date) + 1 Else date_etal = "30/11/" & Year(Date)
Case "décembre"
date_etal = "31/12/" & Year(Date)
End Select
dern = Worksheets("impression").Range("A65000").End(xlUp).Row
If dern < 3 Then dern = 3
date_public = date_etal
Worksheets("impression").Range("A3:AA" & dern).ClearContents
dern = 2
'On Error Resume Next
'macfeuil = True
'Worksheets("instru").Activate
'macfeuil = False

'Copie des instruments à étaloner dans la feuille impression

Worksheets("instru").Range("B5

" & Worksheets("instru").Range("A65000").End(xlUp).Row).Copy
Worksheets("impression").Range("A3").PasteSpecial xlPasteValues
Worksheets("instru").Range("G5:I" & Worksheets("instru").Range("A65000").End(xlUp).Row).Copy
Worksheets("impression").Range("D3").PasteSpecial xlPasteValues
Worksheets("instru").Range("M5:N" & Worksheets("instru").Range("A65000").End(xlUp).Row).Copy
Worksheets("impression").Range("G3").PasteSpecial xlPasteValues
Worksheets("instru").Range("T5:V" & Worksheets("instru").Range("A65000").End(xlUp).Row).Copy
Worksheets("impression").Range("I3").PasteSpecial xlPasteValues
Worksheets("impression").Range("A3:K" & Worksheets("impression").Range("A65000").End(xlUp).Row).Sort _
key1:=Worksheets("impression").Range("H3"), order1:=xlAscending, header:=xlNo
For i = 3 To Worksheets("impression").Range("A65000").End(xlUp).Row
If Worksheets("impression").Range("H" & i) <> "ACTIF" Then
Worksheets("impression").Range("H" & i & ":H" & Worksheets("impression").Range("A65000").End(xlUp).Row).EntireRow. _
Delete
Worksheets("impression").Range("H3:H" & Worksheets("impression").Range("A65000").End(xlUp).Row).Delete _
Shift:=xlToLeft
i = Worksheets("instru").Range("A65000").End(xlUp).Row
End If
Next
Worksheets("impression").Range("A3:J" & Worksheets("impression").Range("A65000").End(xlUp).Row).Sort _
key1:=Worksheets("impression").Range("H3"), order1:=xlDescending, header:=xlNo
i = 3
Do While Worksheets("impression").Range("H" & i) = ""
i = i + 1
Loop
deb = i

Worksheets("impression").Range("A" & deb & ":J" & Worksheets("impression").Range("A65000").End(xlUp).Row).Sort _
key1:=Worksheets("impression").Range("H3"), order1:=xlAscending, header:=xlNo
For i = deb To Worksheets("impression").Range("A65000").End(xlUp).Row
If Worksheets("impression").Range("H" & i) > date_etal Then
Worksheets("impression").Range("H" & i & ":G" & Worksheets("impression").Range("A65000").End(xlUp).Row).EntireRow. _
Delete
i = Worksheets("instru").Range("A65000").End(xlUp).Row
End If
Next

Menu.Hide
menu_hide = True
On Error GoTo 0
'macfeuil = True
'Worksheets("impression").Activate
'macfeuil = False
Range("J1").Formula = "=COUNTA(A3:A1000)"
Range("H3:H" & Range("H65000").End(xlUp).Row).NumberFormat = "[$-40C]mmm-yy;@"
'For i = 3 To Range("G65000").End(xlUp).Row
' If Range("H" & i) <> 0 Then
' Range("H3:H" & i - 1).ClearContents
' i = Range("H65000").End(xlUp).Row
'End If
'Next
For i = 3 To Range("G65000").End(xlUp).Row
Select Case Range("G" & i)
Case "CONFORME"
Range("G" & i) = "C"
Case "DEROGATION DATE"
For j = 1 To Worksheets("instru").Range("B65000").End(xlUp).Row
If Worksheets("instru").Range("B" & j) = Range("A" & i) Then
lgn = j
j = Worksheets("instru").Range("B65000").End(xlUp).Row
End If
Next
' If date_etal < Worksheets("instru").Range("P" & lgn) Then
' Range("G" & i).EntireRow.Delete
' i = i - 1
' Else
Range("G" & i) = "DD"
' Range("H" & i) = Worksheets("instru").Range("P" & lgn)
' End If
Case "DEROGATION ETAT"
Range("G" & i) = "DE"
Case "UTILISATION RESTREINTE"
Range("G" & i) = "UR"
Case "NON CONFORME"
Range("G" & i) = "NC"
End Select
Next
Range("A3:Q" & Range("A65000").End(xlUp).Row).Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
protec
macfeuil = False
End Sub

Private Sub fin_Click()
If ActiveWorkbook.ReadOnly Then Application.DisplayAlerts = False
ActiveWorkbook.Close
End Sub

Private Sub MaJ_etalon_Click()
initialisation_2013
mac_maj = True
If ActiveWorkbook.ReadOnly Then
MsgBox "Fonction indisponible en lecture seule"
ElseIf majdatetal_hide = False Then
mac_maj = False
Exit Sub
End If
Unload Menu
majdatetal.Show
mac_maj = False
End Sub

Private Sub maj_instru_Click()
public_appel_mac = True
If ActiveWorkbook.ReadOnly Then
MsgBox "Fonction indisponible en lecture seule"
Else
Unload Menu
Tool_data.Show
End If
public_appel_mac = False
End Sub

Private Sub new_tool_Click()
If ActiveWorkbook.ReadOnly Then
MsgBox "Fonction indisponible en lecture seule"
Else
choix_moyen.Show
End If
End Sub

Private Sub Planning_Click()
Menu.Hide
menu_hide = True
'Application.ScreenUpdating = False
ActiveWorkbook.Unprotect
macfeuil = True
Worksheets("Planning").Visible = True
Worksheets("Planning").Activate
macfeuil = False
'Application.ScreenUpdating = True
End Sub

Private Sub Planning_RQS_Click()
'Application.ScreenUpdating = False
ActiveWorkbook.Unprotect
macfeuil = True
Worksheets("Planning RQS").Visible = True
Worksheets("Planning RQS").Activate
Menu.Hide
menu_hide = True
macfeuil = False
'Application.ScreenUpdating = True
End Sub

Private Sub prestataires_Click()
macfeuil = True
Menu.Hide
menu_hide = True
Worksheets("Fournisseurs").Activate
macfeuil = False
End Sub

Private Sub save_Click()
If ActiveWorkbook.ReadOnly Then
MsgBox "Fonction indisponible en lecture seule"
Else
ActiveWorkbook.save
End If
End Sub

Private Sub tool_searchbutton_Click()
Unload Menu
Tool_search.Show
End Sub

Private Sub UserForm_Activate() ' menu
If ActiveWorkbook.ReadOnly Then
Menu.Caption = "Bienvenue dans la base Etalonnage" & " [Lecture seule]"
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Commande interdite !" & vbLf & " Veuillez utiliser les boutons de commande du menu pour vos actions."
Cancel = True
End If
End Sub
et majdatetal
Option Explicit
Public mac As Boolean
Private Sub date_cont_Change()

If maj Then
If mac = False Then
unprotec
Worksheets("instru").Range("K" & ligne_outil) = date_cont.Value
Select Case date_cont.Value
Case Is <> ""
retard.Caption = ""
Case Is = ""
If LCase(Worksheets("instru").Range("J" & ligne_outil)) = "r & r" Or LCase(Worksheets("instru"). _
Range("J" & ligne_outil)) = "kappa test" Then
retard.Caption = "MANQUANT"
Else
retard.Caption = ""
End If
End Select
protec
End If
End If
End Sub

Private Sub Date_fin_déro_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim lgn, i As Integer

If mac = False Then
unprotec
mac = True
lgn = Worksheets("instru").Range("B5:B" & Worksheets("instru").Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
If IsDate(Date_fin_déro.Value) Or Date_fin_déro.Value = "" Then
If Date_fin_déro = "" Then
Worksheets("instru").Range("P" & lgn) = ""
Else
If CDate(Date_fin_déro.Value) > Now Then
Worksheets("instru").Range("P" & lgn) = Format(Date_fin_déro.Value, "mm/dd/yyyy")
Else
MsgBox "Attention, vous avez saisi une date de fin de déro antérieure à l'instant présent !" & vbLf & _
"Veuillez corriger !!"
Date_fin_déro.Value = ""
End If
End If
Else
MsgBox "la saisie ne correspond pas à une date. Veuillez corriger !"
Date_fin_déro.Value = Format(Worksheets("instru").Range("P" & lgn), "dd/mm/yyyy")
End If
mac = False
protec
End If

End Sub

Private Sub famBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If statutbox.Value <> "DEROGATION DATE" Or Date_fin_déro.Value <> "" Then Exit Sub
MsgBox "Vous n'avez pas renseigné la date de fin de dérogation !"
End Sub

Private Sub Observations_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim lgn As Integer

If mac = False Then
unprotec
mac = True
lgn = Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
Range("Z" & lgn) = Observations.Value
mac = False
protec
End If

End Sub
Private Sub etalbox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim lgn, i, rep As Integer
Dim olddate As String

'Application.EnableEvents = False
If mac = False Then
unprotec
mac = True
lgn = Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
If IsDate(etalbox.Value) Then
olddate = Range("S" & lgn)
Range("S" & lgn) = etalbox.Value
prochbox.Value = Format(Range("T" & lgn), "mm/yyyy")
If statutbox.Value = "DEROGATION DATE" And CDate(prochbox.Value) > Now Then
MsgBox "ATTENTION, Le statut ne peut pas être DEROGATION DATE car la date de prochain etalonnage n'est pas dépassée" _
& vbLf & "Vous devez modifier le statut"
Range("S" & lgn) = olddate
etalbox.Value = olddate
prochbox.Value = Format(Range("T" & lgn), "mm/yyyy")
End If
If CDate(etalbox.Value) > Now Then
MsgBox "ATTENTION, La date d'étalonnage renseignée n'est pas passée !" _
& vbLf & "La date d'étalonnage correspond à la date à laquelle il a été réalisé et le rapport reçu."
Range("S" & lgn) = olddate
etalbox.Value = olddate
prochbox.Value = Format(Range("T" & lgn), "mm/yyyy")
End If
Else
If etalbox.Value <> "" Then
MsgBox "la saisie ne correspond pas à une date. Veuillez corriger !"
etalbox.Value = Format(Range("S" & lgn), "mm/yyyy")
Else
rep = MsgBox("Vous n'avez pas saisi de date d'étalonnage ! " & vbLf & "Confirmez vous ce choix ?", vbYesNo)
If rep = "7" Then
etalbox.Value = Format(Range("S" & lgn), "mm/yyyy")
Else
Range("S" & lgn) = ""
End If
End If
End If
End If
mac = False
'Application.EnableEvents = True
protec
End Sub

Private Sub Etatbox_Change()

Dim i As Integer
Dim trouve As Boolean

If mac = False Then
unprotec
trouve = False
mac = True

' controle de la valeur tapée dans la case etat
For i = 5 To Worksheets("Init").Range("N65000").End(xlUp).Row
If LCase(etatbox.Value) = LCase(Worksheets("Init").Range("N" & i)) Then
trouve = True
i = Worksheets("Init").Range("N65000").End(xlUp).Row
End If
Next
If trouve = False Then
etatbox.Value = ""
Else
Range("N" & Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row) = etatbox.Value
End If
mac = False
protec
End If

End Sub

Private Sub famBox_Change()
Dim i As Integer
Dim lgn As Integer
Dim existe As Boolean

If mac = False And Not public_appel_mac Then
unprotec

' vérification que la saisie dans la case famille corresponde à une valeur existante dans la liste des familles existantes

existe = False
For i = 5 To Worksheets("Init").Range("C65000").End(xlUp).Row
If famBox.Value = Left(Worksheets("Init").Range("C" & i), Len(famBox.Value)) Then existe = True
Next
If Not existe Then
famBox.Value = Left(famBox.Value, Len(famBox.Value) - 1)
Exit Sub
End If
mac = True
'Application.EnableEvents = False

' MaJ de la liste des outils correspondants à la famille séléctionnée

toolBox.RowSource = ""
lgn = 5
Worksheets("Init").Range("B5:B" & Worksheets("Init").Range("B65000").End(xlUp).Row).ClearContents
Worksheets("Init").Range("B5") = "Tous"
toolBox.Value = ""
designbox.Value = ""
marqbox.Value = ""
respbox.Value = ""
seriebox.Value = ""
refbox.Value = ""
Référent.Value = ""
statutbox.Value = ""
etatbox.Value = ""
Labobox.Value = ""
etalbox.Value = ""
prochbox.Value = ""
Observations.Value = ""
If famBox.Value <> "" Then
For i = 5 To Range("B65000").End(xlUp).Row
If Range("C" & i) = famBox.Value Then
lgn = lgn + 1
Worksheets("Init").Range("B" & lgn) = Range("B" & i)
End If
Next
Else
Range("B5:B" & Range("B65000").End(xlUp).Row).Copy
Worksheets("Init").Range("B6").PasteSpecial
Worksheets("Init").Range("B5") = "Tous"
Application.CutCopyMode = False
End If
If lgn > 6 Then Worksheets("Init").Range("B6:B" & lgn).Sort key1:=Worksheets("Init").Range("B6")
macfeuil = True
Worksheets("Init").Activate
toolBox.RowSource = "B5:B" & Range("B65000").End(xlUp).Row
Worksheets("instru").Activate
macfeuil = False
'Application.EnableEvents = True
mac = False
protec
End If
End Sub

Private Sub Okbutton_Click()
If statutbox.Value = "DEROGATION DATE" And Date_fin_déro.Value = "" Then
MsgBox "Vous n'avez pas renseigné la date de fin de dérogation !"
Date_fin_déro.SetFocus
Exit Sub
End If
majdatetal_hide = True
Unload majdatetal
Menu.Show 0
maj_mac = False
End Sub
Private Sub refbox_AfterUpdate()
Dim lgn As Integer
If mac = False Then
unprotec
mac = True
lgn = Worksheets("instru").Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
Range("I" & lgn) = refbox.Value
mac = False
protec
End If
End Sub
Private Sub Référent_change()
Dim i As Integer
Dim lgn As Integer
Dim existe As Boolean

'On Error Resume Next
If mac = False And Not public_appel_mac Then
unprotec
existe = False
For i = 5 To Worksheets("Init").Range("H65000").End(xlUp).Row
If Référent.Value = Left(Worksheets("Init").Range("H" & i), Len(Référent.Value)) Then existe = True
Next
If Not existe And Len(Référent.Value) > 0 Then
Référent.Value = Left(Référent.Value, Len(Référent.Value) - 1)
Exit Sub
End If
mac = True
'Application.EnableEvents = False
toolBox.RowSource = ""
lgn = 5
Worksheets("Init").Range("B5:B" & Worksheets("Init").Range("B65000").End(xlUp).Row + 2).ClearContents
toolBox.Value = ""
designbox.Value = ""
marqbox.Value = ""
famBox.Value = ""
respbox.Value = ""
refbox.Value = ""
seriebox.Value = ""
statutbox.Value = ""
etatbox.Value = ""
Labobox.Value = ""
etalbox.Value = ""
prochbox.Value = ""
Observations.Value = ""
If Référent.Value <> "" Then
For i = 5 To Range("B65000").End(xlUp).Row
If Range("H" & i) = Référent.Value Then
lgn = lgn + 1
Worksheets("Init").Range("B" & lgn) = Range("B" & i)
End If
Next
Else
Worksheets("instru").Range("B5:B" & Worksheets("instru").Range("B65000").End(xlUp).Row).Copy
Worksheets("Init").Range("B6").PasteSpecial
Application.CutCopyMode = False
End If
Worksheets("Init").Range("B6:B" & Worksheets("Init").Range("B65000").End(xlUp).Row).Sort key1:=Worksheets("Init"). _
Range("B6")
toolBox.RowSource = "Init!B5:B" & Worksheets("Init").Range("B65000").End(xlUp).Row
'Application.EnableEvents = True
mac = False
protec
End If
On Error GoTo 0

End Sub

Private Sub Référent_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If statutbox.Value <> "DEROGATION DATE" Or Date_fin_déro.Value <> "" Then Exit Sub
MsgBox "Vous n'avez pas renseigné la date de fin de dérogation !"
End Sub

Private Sub respbox_AfterUpdate()
Dim lgn As Integer
If mac = False Then
unprotec
mac = True
lgn = Worksheets("instru").Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
Range("G" & lgn) = respbox.Value
mac = False
protec
End If
End Sub
Private Sub seriebox_AfterUpdate()
Dim lgn As Integer
If mac = False Then
unprotec
mac = True
lgn = Worksheets("instru").Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
Range("Q" & lgn) = seriebox.Value
mac = False
protec
End If

End Sub

Private Sub statutbox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

If Not (IsDate(prochbox.Value)) Then
Exit Sub
End If
If statutbox.Value = "DEROGATION DATE" And CDate(prochbox.Value) > Now Then
MsgBox "ATTENTION, Le statut ne peut pas être DEROGATION DATE car la date de prochain etalonnage n'est pas dépassée" _
& vbLf & "Vous devez modifier le statut"
Cancel = True
End If

End Sub

Private Sub statutbox_Change()
Dim i, lgn As Integer
Dim trouve As Boolean

If mac = False Then
unprotec
trouve = False
mac = True
For i = 1 To Worksheets("instru").Range("B65000").End(xlUp).Row
If Range("B" & i) = tool Then
lgn = i
i = Worksheets("instru").Range("B65000").End(xlUp).Row
End If
Next
' controle de la valeur tapée dans la case statut
For i = 6 To Worksheets("Init").Range("M65000").End(xlUp).Row
If LCase(statutbox.Value) = LCase(Worksheets("Init").Range("M" & i)) Then
trouve = True
i = Worksheets("Init").Range("M65000").End(xlUp).Row
End If
Next
If trouve = False Then
statutbox.Value = ""
Else
Worksheets("instru").Range("M" & Worksheets("instru").Range("B5:B" & Range("B65000").End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row) = statutbox.Value
End If
If statutbox.Value = "DEROGATION DATE" Then
Fin_dero.Caption = "Date de fin de dérogation"
Date_fin_déro.ForeColor = 1
Date_fin_déro.BorderStyle = 1
Date_fin_déro.Locked = False
Date_fin_déro.Value = Range("P" & lgn)
Else
Fin_dero.Caption = ""
Date_fin_déro.ForeColor = 0
Date_fin_déro.BorderStyle = 0
Date_fin_déro.Value = ""
Date_fin_déro.Locked = True
Range("P" & lgn) = ""
End If
mac = False
protec
End If
End Sub

Private Sub toolBox_Change()
Dim lgn As Integer ' Ligne de l'outil concerné
Dim i As Integer, j As Integer
Dim rep As String

Stop
maj = False
macfeuil = True
If mac = False Then
unprotec
mac = True
tool = toolBox.Value
'Application.EnableEvents = False
On Error GoTo erreur
If tool <> "Tous" And tool <> "" Then lgn = Worksheets("instru").Range("B5:B" & Worksheets("instru").Range("B65000") _
.End(xlUp).Row).Find(tool, LookAt:=xlWhole).Row
ligne_outil = lgn
On Error GoTo 0
toolBox.RowSource = ""
If tool <> "" And tool <> "Tous" Then
For i = 1 To Worksheets("instru").Range("B65000").End(xlUp).Row
If Worksheets("instru").Range("B" & i) = tool Then
lgn = i
i = Worksheets("instru").Range("B65000").End(xlUp).Row
End If
Next
famBox.Value = Worksheets("instru").Range("C" & lgn)
designbox.Value = Worksheets("instru").Range("D" & lgn)
marqbox.Value = Worksheets("instru").Range("E" & lgn)
respbox.Value = Worksheets("instru").Range("G" & lgn)
Référent.Value = Worksheets("instru").Range("H" & lgn)
refbox.Value = Worksheets("instru").Range("I" & lgn)
seriebox.Value = Worksheets("instru").Range("Q" & lgn)
statutbox.Locked = False
statutbox.Value = Worksheets("instru").Range("M" & lgn)
etatbox.Locked = False
etatbox.Value = Worksheets("instru").Range("N" & lgn)
Labobox.Value = Worksheets("instru").Range("U" & lgn)
etalbox.Locked = False
etalbox.Value = Format(Worksheets("instru").Range("S" & lgn), "mm/yyyy")
prochbox.Value = Format(Worksheets("instru").Range("T" & lgn), "mm/yyyy")
Observations.Value = Worksheets("instru").Range("Z" & lgn)
specifications.Value = Worksheets("instru").Range("R" & lgn)
typ_cont.Value = Worksheets("instru").Range("J" & lgn)
date_cont.Value = Worksheets("instru").Range("K" & lgn)
If statutbox.Value = "DEROGATION DATE" Then
Fin_dero.Caption = "Date de fin de dérogation"
Date_fin_déro.ForeColor = 1
Date_fin_déro.BorderStyle = 1
Date_fin_déro.Locked = False
Date_fin_déro.Value = Range("P" & lgn)
Else
Fin_dero.Caption = ""
Date_fin_déro.ForeColor = 0
Date_fin_déro.BorderStyle = 0
Date_fin_déro.Value = ""
Date_fin_déro.Locked = True
End If
Select Case Worksheets("instru").Range("K" & lgn)
Case Is <> ""
retard.Caption = ""
Case Is = ""
If Worksheets("instru").Range("J" & lgn) = "R & R" Or LCase(Worksheets("instru"). _
Range("J" & lgn)) = "kappa test" Then
retard.Caption = "MANQUANT"
Else
retard.Caption = ""
End If
End Select
Else
famBox.Value = ""
toolBox.Value = ""
designbox.Value = ""
marqbox.Value = ""
respbox.Value = ""
refbox.Value = ""
Référent.Value = ""
statutbox.Value = ""
statutbox.Locked = True
etatbox.Value = ""
etatbox.Locked = True
Labobox.Value = ""
seriebox.Value = ""
etalbox.Value = ""
prochbox.Value = ""
prochbox.Locked = True
Observations.Value = ""
specifications.Value = ""
typ_cont.Value = ""
date_cont.Value = ""
Fin_dero.Caption = ""
Date_fin_déro.ForeColor = 0
Date_fin_déro.BorderStyle = 0
Date_fin_déro.Value = ""
Date_fin_déro.Locked = True
'macfeuil = True
Worksheets("Init").Activate
famBox.RowSource = "C5:C" & Range("C65000").End(xlUp).Row
Worksheets("instru").Activate
'macfeuil = False
'MsgBox ActiveSheet.Name & vbLf & ActiveSheet.Range("B65000").End(xlUp).Row
Worksheets("instru").Range("B5:B" & Worksheets("instru").Range("B65000").End(xlUp).Row).Copy
Worksheets("Init").Range("B6").PasteSpecial
Worksheets("Init").Range("B5") = "Tous"
Application.CutCopyMode = False
protec
'Application.EnableEvents = True
End If
mac = False
Worksheets("Init").Activate
toolBox.RowSource = "B5:B" & Range("B65000").End(xlUp).Row
'Worksheets("instru").Activate
toolBox.Value = tool
End If
GoTo fin
erreur:
mac = False
On Error GoTo 0
fin:
maj = True
macfeuil = False
MsgBox "avant"
End Sub
Private Sub toolBox_Enter()
'MsgBox "Veuillez taper le référence de votre outil de controle"
'Okbutton.SetFocus
End Sub

Private Sub toolBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If statutbox.Value <> "DEROGATION DATE" Or Date_fin_déro.Value <> "" Then Exit Sub
MsgBox "Vous n'avez pas renseigné la date de fin de dérogation !"
End Sub

Private Sub typ_cont_Change()

If maj Then
If mac = False Then
unprotec
Worksheets("instru").Range("J" & ligne_outil) = typ_cont.Value
Select Case Worksheets("instru").Range("K" & ligne_outil)
Case Is <> ""
retard.Caption = ""
Case Is = ""
If Worksheets("instru").Range("J" & ligne_outil) = "R & R" Or Worksheets("instru").Range("J" & ligne_outil) _
= "Kappa Test" Then
retard.Caption = "MANQUANT"
Else
retard.Caption = ""
End If
End Select
protec
End If
End If

End Sub

Private Sub UserForm_Activate() ' majdatetal
Exit Sub
Dim outil As String
Dim fin As Integer
Dim i, j As Integer ' compteur pour les boucles

majdatetal_hide = False
mac = True
unprotec
macfeuil = True
Worksheets("Instru").Activate
macfeuil = False
Worksheets("Listes").Range("B5:N" & Worksheets("Listes").Range("B65000").End(xlUp).Row).Copy
Worksheets("Init").Range("B5").PasteSpecial

' Creation d'un liste des familles existantes dans le fichier et initialisation de la liste du userform
'Application.EnableEvents = False
famBox.MatchEntry = fmMatchEntryComplete
famBox.RowSource = ""
famBox.Value = ""
toolBox.Value = ""
designbox.Value = ""
marqbox.Value = ""
Référent.Value = ""
respbox.Value = ""
refbox.Value = ""
seriebox.Value = ""
statutbox.Value = ""
etatbox.Value = ""
Labobox.Value = ""
etalbox.Value = ""
statutbox.Value = ""
prochbox.Value = ""
Observations.Value = ""
specifications.Value = ""
maj = False
typ_cont.Value = ""
typ_cont.MatchRequired = True
date_cont.Value = ""
retard.Caption = ""
Fin_dero.Caption = ""
Date_fin_déro.ForeColor = 0
Date_fin_déro.BorderStyle = 0
Date_fin_déro.Value = ""
Date_fin_déro.Locked = True
famBox.RowSource = "Init!C6:C" & Worksheets("Init").Range("C65000").End(xlUp).Row
typ_cont.RowSource = "Init!K5:K8"

' Initialisation de la liste des référents du userform

Référent.RowSource = "Init!H5:H" & Worksheets("Init").Range("H65000").End(xlUp).Row

' Initialisation de la liste des outils du userform

toolBox.MatchEntry = fmMatchEntryComplete
toolBox.RowSource = "Init!B5:B" & Worksheets("Init").Range("B65000").End(xlUp).Row
'Application.EnableEvents = True

' Initialisation de la liste des statuts

statutbox.RowSource = "Listes!M5:M" & Worksheets("Listes").Range("M65000").End(xlUp).Row
macfeuil = True
Worksheets("instru").Activate
macfeuil = False

' Initialisation de la liste des etats

etatbox.RowSource = "Listes!N5:N" & Worksheets("Listes").Range("N65000").End(xlUp).Row

' Initialisation de la liste des responsables

protec
mac = False
toolBox.Value = Worksheets("Instru").Range("B6")
maj = True
'maj_mac = True
End Sub

Private Sub UserForm_Initialize()
Dim outil As String
Dim fin As Integer
Dim i, j As Integer ' compteur pour les boucles

majdatetal_hide = False
mac = True
unprotec
macfeuil = True
Worksheets("Instru").Activate
macfeuil = False
Worksheets("Listes").Range("B5:N" & Worksheets("Listes").Range("B65000").End(xlUp).Row).Copy
Worksheets("Init").Range("B5").PasteSpecial

' Creation d'un liste des familles existantes dans le fichier et initialisation de la liste du userform
'Application.EnableEvents = False
famBox.MatchEntry = fmMatchEntryComplete
famBox.RowSource = ""
famBox.Value = ""
toolBox.Value = ""
designbox.Value = ""
marqbox.Value = ""
Référent.Value = ""
respbox.Value = ""
refbox.Value = ""
seriebox.Value = ""
statutbox.Value = ""
etatbox.Value = ""
Labobox.Value = ""
etalbox.Value = ""
statutbox.Value = ""
prochbox.Value = ""
Observations.Value = ""
specifications.Value = ""
maj = False
typ_cont.Value = ""
typ_cont.MatchRequired = True
date_cont.Value = ""
retard.Caption = ""
Fin_dero.Caption = ""
Date_fin_déro.ForeColor = 0
Date_fin_déro.BorderStyle = 0
Date_fin_déro.Value = ""
Date_fin_déro.Locked = True
famBox.RowSource = "Init!C6:C" & Worksheets("Init").Range("C65000").End(xlUp).Row
typ_cont.RowSource = "Init!K5:K8"

' Initialisation de la liste des référents du userform

Référent.RowSource = "Init!H5:H" & Worksheets("Init").Range("H65000").End(xlUp).Row

' Initialisation de la liste des outils du userform

toolBox.MatchEntry = fmMatchEntryComplete
toolBox.RowSource = "Init!B5:B" & Worksheets("Init").Range("B65000").End(xlUp).Row
'Application.EnableEvents = True

' Initialisation de la liste des statuts

statutbox.RowSource = "Listes!M5:M" & Worksheets("Listes").Range("M65000").End(xlUp).Row
macfeuil = True
Worksheets("instru").Activate
macfeuil = False

' Initialisation de la liste des etats

etatbox.RowSource = "Listes!N5:N" & Worksheets("Listes").Range("N65000").End(xlUp).Row

' Initialisation de la liste des responsables

protec
mac = False
toolBox.Value = Worksheets("Instru").Range("B6")
maj = True
'maj_mac = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Commande interdite !" & vbLf & " Veuillez utiliser le bouton OK pour quitter ce menu"
Cancel = True
End If
'maj_mac = False
End Sub
Si nécessaire, je peux essayer d'envoyer le fichier complet par mail en limitant les données pour l'alléger

Paf · 10 Octobre 2014

Re : Erreur automation

Bonjour

désolé c'est imbuvable !

de plus je suis limité à XL2003

mais sans classeur même allégé, pas sûr que quelqu'un se penche sur votre problème .

Bonne suite

hiautoliv · 13 Octobre 2014

Re : Erreur automation

Effectivement, cela est très obscur et inutilisable en l'état. Mon problème est que pour faire un fichier que je puisse attacher au post, je suis obligé de supprimer un nombre de données important qui supprime le problème, mais rends la base inopérante.
Je vais donc essayer d'expliquer le phénomène tel que je l'ai compris :
Dans une textbox sur un Userform, j'utilise l'évènement change pour reconnaitre l'élément de la base à modifier. Dès qu'on tape un caractère, je recherche le premier élément débutant par la chaine de caractères correspondant et je l'affiche dans la textbox. Sous excel 2010, cela fonctionne parfaitement, mais sous 2013, lorsque je change le 2ème caractère, je récupère l'erreur automation. La macro de l'évènement change s'effectue bien jusqu'à la fin, et au end sub, VBA plante dans ma macro principale sur l'affichage du userform (majdatetal.show) comme si on avait demandé la fermeture du userform. Si je tape un 2ème caractère identique à celui affiche dans la textbox, pas de problème et la selection peut s'effectuer. de même, si je choisis un élément de la liste déroulante de la textbox, les macros ne plantent pas. Je pense donc qu'il doit y avoir un changemen dans la gestion des évènements que je n'arrive pas à cerner avec le passage à 2013. Donc si quelqu'un à une piste à me donner, je suis preneur.

Robert · 13 Octobre 2014

Re : Erreur automation

Bonjour le fil, bonjour le forum,

Ça me paraît illogique d'afficher le résultat de la recherche dans la même TextBox que celle où tu tapes le texte à rechercher. Ça relance la procédure Change et peut provoquer un bug.
Peux-tu extraire de ton code juste cette procédure...

Avec deux TextBoxes, ça marche sans problème :

Code:

Private Sub TextBox1_Change()
Dim R As Range

Set R = Sheets("Feuil1").Columns(1).Find(Me.TextBox1.Value & "*", , xlValues, xlWhole)
If Not R Is Nothing Then Me.TextBox2.Value = R.Value
End Sub

Effectuez une recherche sur Excel Downloads...

Erreur automation

hiautoliv

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

hiautoliv

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

hiautoliv

XLDnaute Nouveau

Robert

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums