Erreur d'éxécution '-2147417848 (80010108)': à résoudre
Bonjour à tous,
Ce matin, j'ai un petit souci quand je clique sur le bouton "Rechercher" de mon formulaire. Que dois-je faire ?
Voici le code de ma macro pour ce bouton :
Private Sub CommandButton1_Click()
'dés que l'utilisateur clique sur le bouton rechercher
Dim numeros As Long
'Sélection de la ligne correspondante dans la feuille 1
Sheets("Feuil1").Select
emplacement = 13
'Création de la variable "Contenu" qui nous donne la valeur de la colonne A à la ligne 13,14,15 ...
contenu = Range("A" & emplacement).Value
'Création de la variable "Numeros" étant le numéro du plan de controle
numeros = Box_numero_plan_controle.Value
'Vérifie que le numéro entré a bien une valeur numérique
If IsNumeric(numeros) Then
'Tant que le numéro saisi est différent d'un de ceux présent dans la base de donnée
Do While (contenu <> numeros)
emplacement = emplacement + 1
contenu = Range("A" & emplacement).Formula
Loop
Range("A" & emplacement).Select
Else
'Si le numéro n'est pas de type "numérique", on retourne sur la feuille 1
MsgBox ("Numéro erroné!")
Sheets("Feuil1").Select
End
End If
'Trouver le rapport d'audit dans le répertoire
Dim Fichier As String
'_______________________________________________
'Chemin d'accès à changer si besoin
'_______________________________________________
'chemin = "V:\RAPPORTS\" & "\*.*"
'chemin = "X:\Qualité Opérationelle\RAPPORTS\" & "\*.*"
chemin = "P:\03-Fournisseurs\05-CONTROLE RECEPTION\03 - PROGICIEL\RAPPORTS\" & "\*.*"
Fichier = Dir(chemin)
'Tant que la condition est vraie, la boucle est exécutée
Do While (Len(Fichier) > 0)
Dim Mystr, lastword
Mystr = Fichier
lastword = Left(Mystr, 3)
If lastword = numeros Then
nomFichier = Fichier
beug = 1
End If
Fichier = Dir()
Loop
'Si le programme ne trouve rien dans le dossier
If beug = 0 Then
' Définit le message
Msg = "L'instruction de contrôle n°" & numeros & " ne se trouve pas dans le répertoire "
' Définit les boutons
Style = vbYes + vbCritical + vbDefaultButton2
' Définit le titre
Title = "Erreur !!! "
' Affiche le message
Response = MsgBox(Msg, Style, Title)
Else
End If
Sheets("base").Select
Frame1.Visible = True
'_______________________________________________
'Chemin d'accès à changer si besoin
'_______________________________________________
'Workbooks.Open "V:\RAPPORTS\" & nomFichier
'Workbooks.Open "X:\Qualité Opérationelle\RAPPORTS\" & nomFichier
Workbooks.Open "P:\03-Fournisseurs\05-CONTROLE RECEPTION\03 - PROGICIEL\RAPPORTS\" & nomFichier
'____________________________________________________________________________________________________
'Reporte dans le formulaire de "Saisie des contrôles" les valeurs de la cible sur les 8 pages
'____________________________________________________________________________________________________
'Valeur cible caractéristique 1
LB1 = Range("B9,M9,X9,AI9,AT9")
Label465 = Range("B9,M9,X9,AI9,AT9")
Label525 = Range("B9,M9,X9,AI9,AT9")
Label621 = Range("B9,M9,X9,AI9,AT9")
Label651 = Range("B9,M9,X9,AI9,AT9")
Label681 = Range("B9,M9,X9,AI9,AT9")
Label711 = Range("B9,M9,X9,AI9,AT9")
Label741 = Range("B9,M9,X9,AI9,AT9")
'Valeur cible caractéristique 2
LB2 = Range("C9,N9,Y9,AJ9,AU9")
Label466 = Range("C9,N9,Y9,AJ9,AU9")
Label526 = Range("C9,N9,Y9,AJ9,AU9")
Label622 = Range("C9,N9,Y9,AJ9,AU9")
Label652 = Range("C9,N9,Y9,AJ9,AU9")
Label682 = Range("C9,N9,Y9,AJ9,AU9")
Label712 = Range("C9,N9,Y9,AJ9,AU9")
Label742 = Range("C9,N9,Y9,AJ9,AU9")
'Valeur cible caractéristique 3
LB3 = Range("D9,O9,Z9,AK9, AV9")
Label467 = Range("D9,O9,Z9,AK9, AV9")
Label527 = Range("D9,O9,Z9,AK9, AV9")
Label623 = Range("D9,O9,Z9,AK9, AV9")
Label653 = Range("D9,O9,Z9,AK9, AV9")
Label683 = Range("D9,O9,Z9,AK9, AV9")
Label713 = Range("D9,O9,Z9,AK9, AV9")
Label743 = Range("D9,O9,Z9,AK9, AV9")
'Valeur cible caractéristique 4
LB4 = Range("E9,P9,AA9, AL9,AW9")
Label468 = Range("E9,P9,AA9, AL9,AW9")
Label528 = Range("E9,P9,AA9, AL9,AW9")
Label624 = Range("E9,P9,AA9, AL9,AW9")
Label654 = Range("E9,P9,AA9, AL9,AW9")
Label684 = Range("E9,P9,AA9, AL9,AW9")
Label714 = Range("E9,P9,AA9, AL9,AW9")
Label744 = Range("E9,P9,AA9, AL9,AW9")
'Valeur cible caractéristique 5
LB5 = Range("F9,Q9,AB9, AM9,AX9")
Label469 = Range("F9,Q9,AB9, AM9,AX9")
Label529 = Range("F9,Q9,AB9, AM9,AX9")
Label625 = Range("F9,Q9,AB9, AM9,AX9")
Label655 = Range("F9,Q9,AB9, AM9,AX9")
Label685 = Range("F9,Q9,AB9, AM9,AX9")
Label715 = Range("F9,Q9,AB9, AM9,AX9")
Label745 = Range("F9,Q9,AB9, AM9,AX9")
'Valeur cible caractéristique 6
LB6 = Range("G9,R9,AC9, AN9, AY9")
Label470 = Range("G9,R9,AC9, AN9, AY9")
Label530 = Range("G9,R9,AC9, AN9, AY9")
Label626 = Range("G9,R9,AC9, AN9, AY9")
Label656 = Range("G9,R9,AC9, AN9, AY9")
Label686 = Range("G9,R9,AC9, AN9, AY9")
Label716 = Range("G9,R9,AC9, AN9, AY9")
Label746 = Range("G9,R9,AC9, AN9, AY9")
'Valeur cible caractéristique 7
LB7 = Range("H9,S9,AD9,AO9,AZ9")
Label471 = Range("H9,S9,AD9,AO9,AZ9")
Label531 = Range("H9,S9,AD9,AO9,AZ9")
Label627 = Range("H9,S9,AD9,AO9,AZ9")
Label657 = Range("H9,S9,AD9,AO9,AZ9")
Label687 = Range("H9,S9,AD9,AO9,AZ9")
Label717 = Range("H9,S9,AD9,AO9,AZ9")
Label747 = Range("H9,S9,AD9,AO9,AZ9")
'Valeur cible caractéristique 8
LB8 = Range("I9,T9,AE9, AP9,BA9")
Label472 = Range("I9,T9,AE9, AP9,BA9")
Label532 = Range("I9,T9,AE9, AP9,BA9")
Label628 = Range("I9,T9,AE9, AP9,BA9")
Label658 = Range("I9,T9,AE9, AP9,BA9")
Label688 = Range("I9,T9,AE9, AP9,BA9")
Label718 = Range("I9,T9,AE9, AP9,BA9")
Label748 = Range("I9,T9,AE9, AP9,BA9")
'Valeur cible caractéristique 9
LB9 = Range("J9,U9,AF9,AQ9,BB9")
Label473 = Range("J9,U9,AF9,AQ9,BB9")
Label533 = Range("J9,U9,AF9,AQ9,BB9")
Label629 = Range("J9,U9,AF9,AQ9,BB9")
Label659 = Range("J9,U9,AF9,AQ9,BB9")
Label689 = Range("J9,U9,AF9,AQ9,BB9")
Label719 = Range("J9,U9,AF9,AQ9,BB9")
Label749 = Range("J9,U9,AF9,AQ9,BB9")
'Valeur cible caractéristique 10
LB10 = Range("K9,V9,AG9,AR9,BC9")
Label474 = Range("K9,V9,AG9,AR9,BC9")
Label534 = Range("K9,V9,AG9,AR9,BC9")
Label630 = Range("K9,V9,AG9,AR9,BC9")
Label660 = Range("K9,V9,AG9,AR9,BC9")
Label690 = Range("K9,V9,AG9,AR9,BC9")
Label720 = Range("K9,V9,AG9,AR9,BC9")
Label750 = Range("K9,V9,AG9,AR9,BC9")
'Reporte dans le formulaire de "Saisie des données", partie Décision les valeurs de la cible
LB11 = Range("B9,M9,X9,AI9,AT9")
LB12 = Range("C9,N9,Y9,AJ9,AU9")
LB13 = Range("D9,O9,Z9,AK9, AV9")
LB14 = Range("E9,P9,AA9, AL9,AW9")
LB15 = Range("F9,Q9,AB9, AM9,AX9")
LB16 = Range("G9,R9,AC9, AN9, AY9")
LB17 = Range("H9,S9,AD9,AO9,AZ9")
LB18 = Range("I9,T9,AE9, AP9,BA9")
LB19 = Range("J9,U9,AF9,AQ9,BB9")
LB20 = Range("K9,V9,AG9,AR9,BC9")
'Reporte dans le formulaire de "Saisie des données", partie Décision les valeurs de la limite supérieure
LB21 = Range("B11,M11,X11,AI11,AT11")
LB22 = Range("C11,N11,Y11,AJ11,AU11")
LB23 = Range("D11,O11,Z11,AK11, AV11")
LB24 = Range("E11,P11,AA11, AL11,AW11")
LB25 = Range("F11,Q11,AB11, AM11,AX11")
LB26 = Range("G11,R11,AC11, AN11, AY11")
LB27 = Range("H11,S11,AD11,AO11,AZ11")
LB28 = Range("I11,T11,AE11, AP11,BA11")
LB29 = Range("J11,U11,AF11,AQ11,BB11")
LB30 = Range("K11,V11,AG11,AR11,BC11")
'Reporte dans le formulaire de "Saisie des données", partie Décision les valeurs de la limite inférieure
LB31 = Range("B12,M12,X12,AI12,AT12")
LB32 = Range("C12,N12,Y12,AJ12,AU12")
LB33 = Range("D12,O12,Z12,AK12, AV12")
LB34 = Range("E12,P12,AA12, AL12,AW12")
LB35 = Range("F12,Q12,AB12, AM12,AX12")
LB36 = Range("G12,R12,AC12, AN12, AY12")
LB37 = Range("H12,S12,AD12,AO12,AZ12")
LB38 = Range("I12,T12,AE12, AP12,BA12")
LB39 = Range("J12,U12,AF12,AQ12,BB12")
LB40 = Range("K12,V12,AG12,AR12,BC12")
End SubMerci d'avance,
Bonne journée,
Cdlt,
Floo73
Hello Floo73.
Sans aucune conviction mais comme ça le mappage de tes disques réseaux pour accéder à tes fichiers non pas changés ?
Cdlt.
Salut,
Merci pour ta réponse,
Je ne connais pas trop le terme "mappage" mais ca m'a l'air d'être une histoire de disques réseaux en effet !
Tout est revenu dans l'ordre sans que je ne fasse rien, mais des fois que l'erreur se reproduise, j'aimerais connaître la cause ...
Bonne journée à toi,
Floo73
Alors j'entendais par mappage le fait d'associer une lettre à une ressource réseau tel que par exemple "Z:" à "\\serveur1\dossier1\sous-dossier1\tonfichierexcel". M'enfin le principal c'est que ton dysfonctionnement soit résolu.
Bonne journée.
Cdlt.
Bonjour,
J'ai recommencé à avoir le même problème. Une fois l'éditeur VBA ouvert une fois, le programme fonctionne normalement.
Je rencontre ce problème le matin en début de journée et l'après-midi lorsque le programme n'a pas été beaucoup utilisé le matin ...
En espérant que quelqu'un ait une réponse à m'apporter,
Bonne fin de journée,
Floo73
Bonjour,
Toujours personne n'a de proposition de solution ?
Bon aprèm,
Cdlt,
Floo73
Bonjour.
Pour moi le probleme ne viens pas d'excel je pencherais plus sur par exemple la mise en veille de ta carte réseau où un truc du genre.
Cdlt.
Salut bigdaddy154,
Merci de voler à mon secour !
J'ai surement pas été assez explicite mais mon appli est au service de mon entreprise.
Elle est posée sur un lecteur réseau partagée entre plusieurs utilisateurs donc oui je pense qu'il y a une activité réseau qui me pose des soucis.
J'ai une manière artisanale de contourner le problème. Avant que je clique sur le bouton qui me génère le problème en question, j'ouvre l'éditeur VBA, je sauvegarde le code, et je referme et tout marche normalement.
J'hésite à coder cette manip au clique du bouton ...
En espérant que ces éléments te permettent de m'apporter une solution !
Merci de ton aide en tout cas,
Cdlt,
Floo73 désespéré
Salut à tous,
Est-ce que quelqu'un peut éplucher mon code pour essayer de me dire ce qui cloche ?
Private Sub CommandButton1_Click()
'dés que l'utilisateur clique sur le bouton rechercher
Dim numeros As Long
'Sélection de la ligne correspondante dans la feuille 1
Sheets("Feuil1").Select
emplacement = 13
'Création de la variable "Contenu" qui nous donne la valeur de la colonne A à la ligne 13,14,15 ...
contenu = Range("A" & emplacement).Value
'Création de la variable "Numeros" étant le numéro du plan de controle
numeros = Box_numero_plan_controle.Value
'Vérifie que le numéro entré a bien une valeur numérique
If IsNumeric(numeros) Then
'Tant que le numéro saisi est différent d'un de ceux présent dans la base de donnée
Do While (contenu <> numeros)
emplacement = emplacement + 1
contenu = Range("A" & emplacement).Formula
Loop
Range("A" & emplacement).Select
Else
'Si le numéro n'est pas de type "numérique", on retourne sur la feuille 1
MsgBox ("Numéro erroné!")
Sheets("Feuil1").Select
End
End If
'Trouver le rapport d'audit dans le répertoire
Dim Fichier As String
'_______________________________________________
'Chemin d'accès à changer si besoin
'_______________________________________________
'chemin = "V:\RAPPORTS\" & "\*.*"
'chemin = "X:\Qualité Opérationelle\RAPPORTS\" & "\*.*"
chemin = "P:\03-Fournisseurs\05-CONTROLE RECEPTION\03 - PROGICIEL\RAPPORTS\" & "\*.*"
Fichier = Dir(chemin)
'Tant que la condition est vraie, la boucle est exécutée
Do While (Len(Fichier) > 0)
Dim Mystr, lastword
Mystr = Fichier
lastword = Left(Mystr, 3)
If lastword = numeros Then
nomFichier = Fichier
beug = 1
End If
Fichier = Dir()
Loop
'Si le programme ne trouve rien dans le dossier
If beug = 0 Then
' Définit le message
Msg = "L'instruction de contrôle n°" & numeros & " ne se trouve pas dans le répertoire "
' Définit les boutons
Style = vbYes + vbCritical + vbDefaultButton2
' Définit le titre
Title = "Erreur !!! "
' Affiche le message
Response = MsgBox(Msg, Style, Title)
Else
End If
Sheets("base").Select
Frame1.Visible = True... le code continue, mais le problème provient à mon avis de cette partie.
Merci d'avance,
Cdlt,
Floo73
Floo73 a écrit :Salut à tous,
Est-ce que quelqu'un peut éplucher mon code pour essayer de me dire ce qui cloche ?
Private Sub CommandButton1_Click() 'dés que l'utilisateur clique sur le bouton rechercher Dim numeros As Long 'Sélection de la ligne correspondante dans la feuille 1 Sheets("Feuil1").Select emplacement = 13 'Création de la variable "Contenu" qui nous donne la valeur de la colonne A à la ligne 13,14,15 ... contenu = Range("A" & emplacement).Value 'Création de la variable "Numeros" étant le numéro du plan de controle numeros = Box_numero_plan_controle.Value 'Vérifie que le numéro entré a bien une valeur numérique If IsNumeric(numeros) Then 'Tant que le numéro saisi est différent d'un de ceux présent dans la base de donnée Do While (contenu <> numeros) emplacement = emplacement + 1 contenu = Range("A" & emplacement).Formula Loop Range("A" & emplacement).Select Else 'Si le numéro n'est pas de type "numérique", on retourne sur la feuille 1 MsgBox ("Numéro erroné!") Sheets("Feuil1").Select End End If 'Trouver le rapport d'audit dans le répertoire Dim Fichier As String '_______________________________________________ 'Chemin d'accès à changer si besoin '_______________________________________________ 'chemin = "V:\RAPPORTS\" & "\*.*" 'chemin = "X:\Qualité Opérationelle\RAPPORTS\" & "\*.*" chemin = "P:\03-Fournisseurs\05-CONTROLE RECEPTION\03 - PROGICIEL\RAPPORTS\" & "\*.*" Fichier = Dir(chemin) 'Tant que la condition est vraie, la boucle est exécutée Do While (Len(Fichier) > 0) Dim Mystr, lastword Mystr = Fichier lastword = Left(Mystr, 3) If lastword = numeros Then nomFichier = Fichier beug = 1 End If Fichier = Dir() Loop 'Si le programme ne trouve rien dans le dossier If beug = 0 Then ' Définit le message Msg = "L'instruction de contrôle n°" & numeros & " ne se trouve pas dans le répertoire " ' Définit les boutons Style = vbYes + vbCritical + vbDefaultButton2 ' Définit le titre Title = "Erreur !!! " ' Affiche le message Response = MsgBox(Msg, Style, Title) Else End If Sheets("base").Select Frame1.Visible = True... le code continue, mais le problème provient à mon avis de cette partie.
Merci d'avance,
Cdlt,
Floo73
Bonjour
Quand tu as l'erreur et que tu fais deboguage, le debogueur surligne quelle partie du code ?
J'ai deux solution pour toi :
Avant le lancement:
- Vérifier que le mappage est effectué : cad verifier que les lecteurs P, x et V sont joignables
ou
Si non joignable:
on les mappe directement.
Cdt,
Salut VB_troyes,
Bon finalement, mystère et boule de gomme, mais quand je sauvegarde mon tableur avant de cliquer sur le fameux bouton, ca ne me déclenche pas l'erreur autom' donc j'ai rajouté une petite ligne de code qui au clique du bouton, sauvegarde systématiquement !
Merci pour votre aide,
Cdlt,
Floo73
Hello
Pour comprendre quand meme, commente ta ligne de sauvegarde et lances le.
Clique sur debogage pour comprendre ce qui tique.
Cdt,