Melidan2006
XLDnaute Nouveau
Bonjour,
J'ai un sérieux problème et j'ai besoin d'Aide! Je ne peux pas envoyer mon outil Excel à des fins de confidentialité de la compagnie. Je suis consciente que ça peut compliquer votre aide...
Voici ce qui se passe... Depuis quelques mois, nous avons été migré sur office 365, excel 2016. J'ai fabriqué un outil excel 2016 en février (Alors que j'étais encore sur windows 7). Les gens l'utilisent via un réseau sécurisé dans la compagnie (eux aussi avec Windows 7).
Le problème: J'ai migré à Windows 10 64 bits en octobre mais pas mes collègues. Ils sont toujours à Windows 7 32 bits.
Chaque fois qu'ils ont une erreur technique, j'ai demandé à Excel de m'envoyer un message d'erreur avec l'information.
Presque Toujours la même chose: Variable objet ou variable de bloc With non définie ou L'indice n'appartient pas à la sélection.
Le code qui est en problème se trouve dans un Module et est déclenché dans un Userform par Call Rech_trans
J'ai validé et mes objects sont tous définis au départ. Je n'ai pas de bloc with dans ce code.
Or, de mon côté, je ne suis pas capable de générer cet erreur, tout fonctionne toujours nickel. De leur côté, l'erreur n,arrive pas toujours, environ 1x sur 2!!!!!
Donc parfois ça fonctionne, parfois non!
Je suis limité avec mes connaissances Excel et nul en Informatique. Je n'arrive pas à corriger la situation, qui devient irritante pour tout le monde! Ils utilisent l'outil environ 20 fois par jour!
Les objets - références actives dans cet outil excel VBA sont:
Merci de votre aide à l'avance, je suis désespérée... je ne compte plus les heures que j'ai mis à tenter de trouver le problème.
Plus bas, je vous donne mon code. EN caractere gras est l'endroit où mon code bloque le plus souvent 99% du temps:
Sub Rech_trans()
'**********************
' VBA ok 2019/02/25 MF
'**********************
'Pour aller chercher toutes les transactions du stagiaire
'Par # de ADMvt de la feuille Recherche/Search
'Possibiliter d'importer également les transactions archivées ou pas, selon le désire du stagiaire
Dim motdp As String
Dim ADMvt As String 'Identification de la transaction
Dim Bonneligne, LigneActive As String
Dim a, b, c, d As String
Dim LeBug As String
Dim i, X As Integer
Dim Nb, Action As Byte 'Pour dire le nombre de transaction(s) trouvée(s)
'MsgBox "La recherche prendra quelques secondes. Veuillez patienter.", vbInformation, "Avis!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Excel.Application.Visible = False
motdp = ThisWorkbook.Sheets("list").Range("A1").Value
ThisWorkbook.Unprotect Password:=motdp
LeBug = "Etape 1"
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
ActiveSheet.Unprotect Password:=motdp
On Error GoTo errorhandler
If Excel.Application.Visible = True Then
Excel.Application.Visible = False
End If
'**********************
' ETAPE 1: Effacer les anciens résultats
'**********************
''Sélectionner la feuille Recherche
'If ActiveSheet.Name <> "Recherche - Search" Then
' LeBug = "Etape 1-1-1"
' ThisWorkbook.Sheets("Recherche - Search").Activate
'End If
LeBug = "Etape 1-2"
ThisWorkbook.Sheets("Recherche - Search").Range("B11
LeBug = "Etape 1-3"
ThisWorkbook.Sheets("Recherche - Search").Range("F11:H3000").ClearContents
LeBug = "Etape 1-4"
'Préparer le critère de l'individu: Linker le Code de l'agent pour retracer toutes ses transactions ds la BD
ADMvt = ThisWorkbook.Sheets("Recherche - Search").Range("B6").Value
'**********************
' ETAPE 2: 'Ouvrir BD en mode lecture seule
'**********************
LeBug = "Etape 2-1"
Workbooks.Open Filename:= _
"G:\SPP\" & ThisWorkbook.Sheets("list").Range("D21").Value, _
ReadOnly:=True
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Activate
Range("A60000").End(xlUp).Select
Bonneligne = ActiveCell.Row
Range("B5").Select
If Range("A6") = "" Then
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
If ActiveWorkbook.Name <> ThisWorkbook.Sheets("list").Range("D22").Value Then
ThisWorkbook.Activate
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Aucune transaction retracée.", vbInformation + vbOKOnly, "Aucune transaction!"
Exit Sub
End If
'**********************
' ETAPE 3: 'Filtrer selon les critères (AdMvt+transctions archivées ou AdMvt sans les transactions archivées
'**********************
'Cell linké avec la case à cocher "Inclure les transactions archivées"
'Filtrer le code ADMvt
LeBug = "Etape 3"
ActiveSheet.Range("$A$5:GE" & Bonneligne).AutoFilter Field:=2, Criteria1:=ADMvt
If ThisWorkbook.Sheets("Recherche - Search").OLEObjects("CheckBox1").Object.Value = False Then 'Ne pas inclure les archives car pas coché
a = ActiveWorkbook.Sheets("Statut").Range("B3").Value
b = ActiveWorkbook.Sheets("Statut").Range("B4").Value
c = ActiveWorkbook.Sheets("Statut").Range("B5").Value
d = ActiveWorkbook.Sheets("Statut").Range("B6").Value
'Filtrer le statut
ActiveSheet.Range("$A$5:GE" & Bonneligne).AutoFilter Field:=17, Criteria1:=Array(a, b, c, d), Operator:=xlFilterValues
End If
'**********************
' ETAPE 4: Importer les transactions demandées - #Transaction, Date, Statut, puis Police#, Nom, Date naiss.
'**********************
'Si pas de transaction pour les critères demandés, ne pas copier car va copier toutes les transactions de tout le monde.
LeBug = "Etape 4"
On Error GoTo errorhandler2
'Trouver la derinère ligne inscrite dans la BD avec les critères demandés.
Range("A6:A" & Range("A65000").End(xlUp).Row).SpecialCells(xlVisible).Cells(1, 1).Select 'Si pas de transaction filtrée, va aller à errorhandler2.
' Range("A5").End(xlDown).Select
'***Rendu ici, c'est qu'il y a présence de transactions pour le stagiaire selon ses critères
LigneActive = ActiveCell.Row
If ActiveCell.Value <> "" Then
ActiveCell.End(xlDown).Select
'Empêcher de copier jusqu'à la ligne 1048576 si seulement une transaction
If ActiveCell.Row = 1048576 Then
Bonneligne = LigneActive
ActiveCell.End(xlUp).Select
Else: Bonneligne = ActiveCell.Row
End If
Else: GoTo errorhandler2
End If
'ActiveCell.Offset(0, 1).Select
On Error GoTo errorhandler
' If ActiveCell.Offset(0, 1).Value = ADMvt Then 'Si c'est le code mouvement du stagiaire, copier
' Pour recopier la plage désirée uniquement si présence de transcations ds la BD avec les critères demandés
'#Transaction
Range("A6:A" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("B11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Date
Range("G6:G" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("C11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Statut
Range("Q6:Q" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("D11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'#Police, nom, date naiss.
Range("L6:N" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("F11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' End If
'**********************
' FIN DES ETAPES
'**********************
LeBug = "Fin des etapes-1"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
LeBug = "Fin des etapes-2"
If ActiveWorkbook.Name <> ThisWorkbook.Sheets("list").Range("D22").Value Then
LeBug = "Fin des etapes-2-1"
ThisWorkbook.Activate
End If
LeBug = "Fin des etapes-3"
ThisWorkbook.Sheets("Recherche - Search").Range("H9").Value = Format(Date, "YYYY/MM/DD")
LeBug = "Fin des etapes-4"
ActiveSheet.Protect Password:=motdp
LeBug = "Fin des etapes-5"
If Not ThisWorkbook.ProtectWindows And Not ThisWorkbook.ProtectStructure Then
LeBug = "Fin des etapes-5-1"
ThisWorkbook.Protect Password:=motdp
End If
LeBug = "Fin des etapes-6"
If Excel.Application.Visible = False Then
LeBug = "Fin des etapes-6-1"
Excel.Application.Visible = True
End If
LeBug = "Fin des etapes-7"
'ThisWorkbook.Sheets("Recherche - Search").Range("B11").Activate
LeBug = "Fin des etapes-8"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
LeBug = "Fin des etapes-9"
ThisWorkbook.Save
Exit Sub
errorhandler:
ThisWorkbook.Sheets("list").Range("F18").Value = Err.Description
ThisWorkbook.Sheets("list").Range("E18").Value = "Module 6 Rech_trans"
ThisWorkbook.Sheets("list").Range("D18").Value = "Non"
ThisWorkbook.Sheets("list").Range("D29").Value = LeBug
Call envoi_autre_erreur 'Module 1
ThisWorkbook.Sheets("list").Range("F18").Value = ""
ThisWorkbook.Sheets("list").Range("E18").Value = ""
ThisWorkbook.Sheets("list").Range("D18").Value = ""
ThisWorkbook.Sheets("list").Range("D29").Value = ""
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
Range("B10").Select
If IlEstOuvert(Workbooks, ThisWorkbook.Sheets("list").Range("D21").Value) = True Then
'msgbox "Le classeur est déjà ouvert !"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
End If
ActiveSheet.Protect Password:=motdp
If ThisWorkbook.ProtectWindows Or ThisWorkbook.ProtectStructure Then
Else: ThisWorkbook.Protect Password:=motdp
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
errorhandler2: 'Pour éviter qu'il y ait une erreur technique lorsqu'il n'y a aucune transaction pour ses stagiaires non archivées et que les archives sont exclues de la demande
If IlEstOuvert(Workbooks, ThisWorkbook.Sheets("list").Range("D21").Value) = True Then
'msgbox "Le classeur est déjà ouvert !"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
End If
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
Range("B10").Select
ThisWorkbook.Sheets("Recherche - Search").Protect Password:=motdp
If ThisWorkbook.ProtectWindows Or ThisWorkbook.ProtectStructure Then
Else: ThisWorkbook.Protect Password:=motdp
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
MsgBox "Aucune transaction active!", vbOKOnly + vbInformation, "Vous êtes à jour!"
End Sub
J'ai un sérieux problème et j'ai besoin d'Aide! Je ne peux pas envoyer mon outil Excel à des fins de confidentialité de la compagnie. Je suis consciente que ça peut compliquer votre aide...
Voici ce qui se passe... Depuis quelques mois, nous avons été migré sur office 365, excel 2016. J'ai fabriqué un outil excel 2016 en février (Alors que j'étais encore sur windows 7). Les gens l'utilisent via un réseau sécurisé dans la compagnie (eux aussi avec Windows 7).
Le problème: J'ai migré à Windows 10 64 bits en octobre mais pas mes collègues. Ils sont toujours à Windows 7 32 bits.
Chaque fois qu'ils ont une erreur technique, j'ai demandé à Excel de m'envoyer un message d'erreur avec l'information.
Presque Toujours la même chose: Variable objet ou variable de bloc With non définie ou L'indice n'appartient pas à la sélection.
Le code qui est en problème se trouve dans un Module et est déclenché dans un Userform par Call Rech_trans
J'ai validé et mes objects sont tous définis au départ. Je n'ai pas de bloc with dans ce code.
Or, de mon côté, je ne suis pas capable de générer cet erreur, tout fonctionne toujours nickel. De leur côté, l'erreur n,arrive pas toujours, environ 1x sur 2!!!!!
Donc parfois ça fonctionne, parfois non!
Je suis limité avec mes connaissances Excel et nul en Informatique. Je n'arrive pas à corriger la situation, qui devient irritante pour tout le monde! Ils utilisent l'outil environ 20 fois par jour!
Les objets - références actives dans cet outil excel VBA sont:
Merci de votre aide à l'avance, je suis désespérée... je ne compte plus les heures que j'ai mis à tenter de trouver le problème.
Plus bas, je vous donne mon code. EN caractere gras est l'endroit où mon code bloque le plus souvent 99% du temps:
Sub Rech_trans()
'**********************
' VBA ok 2019/02/25 MF
'**********************
'Pour aller chercher toutes les transactions du stagiaire
'Par # de ADMvt de la feuille Recherche/Search
'Possibiliter d'importer également les transactions archivées ou pas, selon le désire du stagiaire
Dim motdp As String
Dim ADMvt As String 'Identification de la transaction
Dim Bonneligne, LigneActive As String
Dim a, b, c, d As String
Dim LeBug As String
Dim i, X As Integer
Dim Nb, Action As Byte 'Pour dire le nombre de transaction(s) trouvée(s)
'MsgBox "La recherche prendra quelques secondes. Veuillez patienter.", vbInformation, "Avis!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Excel.Application.Visible = False
motdp = ThisWorkbook.Sheets("list").Range("A1").Value
ThisWorkbook.Unprotect Password:=motdp
LeBug = "Etape 1"
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
ActiveSheet.Unprotect Password:=motdp
On Error GoTo errorhandler
If Excel.Application.Visible = True Then
Excel.Application.Visible = False
End If
'**********************
' ETAPE 1: Effacer les anciens résultats
'**********************
''Sélectionner la feuille Recherche
'If ActiveSheet.Name <> "Recherche - Search" Then
' LeBug = "Etape 1-1-1"
' ThisWorkbook.Sheets("Recherche - Search").Activate
'End If
LeBug = "Etape 1-2"
ThisWorkbook.Sheets("Recherche - Search").Range("B11
LeBug = "Etape 1-3"
ThisWorkbook.Sheets("Recherche - Search").Range("F11:H3000").ClearContents
LeBug = "Etape 1-4"
'Préparer le critère de l'individu: Linker le Code de l'agent pour retracer toutes ses transactions ds la BD
ADMvt = ThisWorkbook.Sheets("Recherche - Search").Range("B6").Value
'**********************
' ETAPE 2: 'Ouvrir BD en mode lecture seule
'**********************
LeBug = "Etape 2-1"
Workbooks.Open Filename:= _
"G:\SPP\" & ThisWorkbook.Sheets("list").Range("D21").Value, _
ReadOnly:=True
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Activate
Range("A60000").End(xlUp).Select
Bonneligne = ActiveCell.Row
Range("B5").Select
If Range("A6") = "" Then
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
If ActiveWorkbook.Name <> ThisWorkbook.Sheets("list").Range("D22").Value Then
ThisWorkbook.Activate
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Aucune transaction retracée.", vbInformation + vbOKOnly, "Aucune transaction!"
Exit Sub
End If
'**********************
' ETAPE 3: 'Filtrer selon les critères (AdMvt+transctions archivées ou AdMvt sans les transactions archivées
'**********************
'Cell linké avec la case à cocher "Inclure les transactions archivées"
'Filtrer le code ADMvt
LeBug = "Etape 3"
ActiveSheet.Range("$A$5:GE" & Bonneligne).AutoFilter Field:=2, Criteria1:=ADMvt
If ThisWorkbook.Sheets("Recherche - Search").OLEObjects("CheckBox1").Object.Value = False Then 'Ne pas inclure les archives car pas coché
a = ActiveWorkbook.Sheets("Statut").Range("B3").Value
b = ActiveWorkbook.Sheets("Statut").Range("B4").Value
c = ActiveWorkbook.Sheets("Statut").Range("B5").Value
d = ActiveWorkbook.Sheets("Statut").Range("B6").Value
'Filtrer le statut
ActiveSheet.Range("$A$5:GE" & Bonneligne).AutoFilter Field:=17, Criteria1:=Array(a, b, c, d), Operator:=xlFilterValues
End If
'**********************
' ETAPE 4: Importer les transactions demandées - #Transaction, Date, Statut, puis Police#, Nom, Date naiss.
'**********************
'Si pas de transaction pour les critères demandés, ne pas copier car va copier toutes les transactions de tout le monde.
LeBug = "Etape 4"
On Error GoTo errorhandler2
'Trouver la derinère ligne inscrite dans la BD avec les critères demandés.
Range("A6:A" & Range("A65000").End(xlUp).Row).SpecialCells(xlVisible).Cells(1, 1).Select 'Si pas de transaction filtrée, va aller à errorhandler2.
' Range("A5").End(xlDown).Select
'***Rendu ici, c'est qu'il y a présence de transactions pour le stagiaire selon ses critères
LigneActive = ActiveCell.Row
If ActiveCell.Value <> "" Then
ActiveCell.End(xlDown).Select
'Empêcher de copier jusqu'à la ligne 1048576 si seulement une transaction
If ActiveCell.Row = 1048576 Then
Bonneligne = LigneActive
ActiveCell.End(xlUp).Select
Else: Bonneligne = ActiveCell.Row
End If
Else: GoTo errorhandler2
End If
'ActiveCell.Offset(0, 1).Select
On Error GoTo errorhandler
' If ActiveCell.Offset(0, 1).Value = ADMvt Then 'Si c'est le code mouvement du stagiaire, copier
' Pour recopier la plage désirée uniquement si présence de transcations ds la BD avec les critères demandés
'#Transaction
Range("A6:A" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("B11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Date
Range("G6:G" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("C11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Statut
Range("Q6:Q" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("D11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'#Police, nom, date naiss.
Range("L6:N" & Bonneligne).Copy
ThisWorkbook.Sheets("Recherche - Search").Range("F11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' End If
'**********************
' FIN DES ETAPES
'**********************
LeBug = "Fin des etapes-1"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
LeBug = "Fin des etapes-2"
If ActiveWorkbook.Name <> ThisWorkbook.Sheets("list").Range("D22").Value Then
LeBug = "Fin des etapes-2-1"
ThisWorkbook.Activate
End If
LeBug = "Fin des etapes-3"
ThisWorkbook.Sheets("Recherche - Search").Range("H9").Value = Format(Date, "YYYY/MM/DD")
LeBug = "Fin des etapes-4"
ActiveSheet.Protect Password:=motdp
LeBug = "Fin des etapes-5"
If Not ThisWorkbook.ProtectWindows And Not ThisWorkbook.ProtectStructure Then
LeBug = "Fin des etapes-5-1"
ThisWorkbook.Protect Password:=motdp
End If
LeBug = "Fin des etapes-6"
If Excel.Application.Visible = False Then
LeBug = "Fin des etapes-6-1"
Excel.Application.Visible = True
End If
LeBug = "Fin des etapes-7"
'ThisWorkbook.Sheets("Recherche - Search").Range("B11").Activate
LeBug = "Fin des etapes-8"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
LeBug = "Fin des etapes-9"
ThisWorkbook.Save
Exit Sub
errorhandler:
ThisWorkbook.Sheets("list").Range("F18").Value = Err.Description
ThisWorkbook.Sheets("list").Range("E18").Value = "Module 6 Rech_trans"
ThisWorkbook.Sheets("list").Range("D18").Value = "Non"
ThisWorkbook.Sheets("list").Range("D29").Value = LeBug
Call envoi_autre_erreur 'Module 1
ThisWorkbook.Sheets("list").Range("F18").Value = ""
ThisWorkbook.Sheets("list").Range("E18").Value = ""
ThisWorkbook.Sheets("list").Range("D18").Value = ""
ThisWorkbook.Sheets("list").Range("D29").Value = ""
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
Range("B10").Select
If IlEstOuvert(Workbooks, ThisWorkbook.Sheets("list").Range("D21").Value) = True Then
'msgbox "Le classeur est déjà ouvert !"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
End If
ActiveSheet.Protect Password:=motdp
If ThisWorkbook.ProtectWindows Or ThisWorkbook.ProtectStructure Then
Else: ThisWorkbook.Protect Password:=motdp
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
errorhandler2: 'Pour éviter qu'il y ait une erreur technique lorsqu'il n'y a aucune transaction pour ses stagiaires non archivées et que les archives sont exclues de la demande
If IlEstOuvert(Workbooks, ThisWorkbook.Sheets("list").Range("D21").Value) = True Then
'msgbox "Le classeur est déjà ouvert !"
Workbooks(ThisWorkbook.Sheets("list").Range("D21").Value).Close
Application.Wait Now + TimeValue("0:00:02")
End If
If ActiveSheet.Name <> "Recherche - Search" Then
ThisWorkbook.Sheets("Recherche - Search").Activate
End If
Range("B10").Select
ThisWorkbook.Sheets("Recherche - Search").Protect Password:=motdp
If ThisWorkbook.ProtectWindows Or ThisWorkbook.ProtectStructure Then
Else: ThisWorkbook.Protect Password:=motdp
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Excel.Application.Visible = False Then
Excel.Application.Visible = True
End If
MsgBox "Aucune transaction active!", vbOKOnly + vbInformation, "Vous êtes à jour!"
End Sub
Dernière édition: