Erreur exécution macro
A
Ma macro fonctionnait parfaitement hier , et aujourd'hui quand je la lance elle me met un fichier inexistant bug alors que le dossier dans lequel s'exécute ma macro n'as pas ce fichier , je me suis dis que ca venait de mon pc alors j'ai essayer sur un autre et j'ai eu une erreur aussi avec un autre fichier bugger ,
si quelqu'un à sait comment résoudre se problème je le remercierais 1000 fois.
Sub Refonte_Fichier_AC_Word()
' |-----------------------------------------------------------------------|
' |Macro qui ouvre les fichiers Words (gamme de contrôle) et les |
' |récupèrent les données pour les transmettres dans des fichiers excels |
' |Par : Robin Decaillon -- dernière mise à jour 27/04/2022 |
' |-----------------------------------------------------------------------|
' I-- Déclaration des variables
'-----Variable d'attribution d'office
Dim wb As Workbook 'création d'une variable attachée à un classeur excel
Dim ws As Worksheet 'création d'une variable attachée à une feuille excel
'----Variable pour gestion de fichier
Dim sDossierClient As String
Dim sChemin, sCheminFichier_New As String 'répertoire contenant les fichiers Words / et la destination des fichiers excels
Dim sNomFichier As String 'nom du fichier Word
Dim sFichierExistant As String
Dim sGAC, sClient, sIndice As String 'nom de la Gamme d'Auto-Contrôle
'----Variable de navigation entre Excel et Word
Dim WApp As Object, WDoc As Object, WSel As Object 'variable obligatioire pour naviguer entre word et excel
'----Variables Locales
Dim test1, test2, test3, test4 As String 'variables de test
Dim vplan, i, li, t, Vop, nbtab, a As Integer
'-------fin de déclaration de variables--------
' II---Initialisation de la gestion de fichier
'sCheminFichier_New = "\\server\dossier partage\autocontrole_excel\" 'chemin du dossier des gammes d'Auto-Contrôles Excel
'sChemin = "\\server\dossier partage\autocontrole\" 'chemin du dossier des gammes d'Auto-Contrôles Word
sChemin = "C:\Users\toto\Desktop\TS17\" 'chemin du dossier des gammes d'Auto-Contrôles Word
sCheminFichier_New = "C:\Users\toto\Desktop\Gamme Excel_AC\" 'chemin du dossier des gammes d'Auto-Contrôles Excel
sNomFichier = Dir(sChemin & "*.doc*") 'pour ouvrir tous les fichiers .doc*. 1er fichier attribuer selon le nom.
'Pour ne pas voir les fichiers word s'ouvrir nous mettons cette condition :
Application.ScreenUpdating = False
'III -- Boucle sur les fichiers
'boucle de balyage de tout les fichiers tant que tout les fichiers non pas était ouverts
Do While Len(sNomFichier) > 0
'-----mise en place du nouveau fichier excel
vplan = Len(sNomFichier) - 4 'sNomfichier est écrit de cette façon : nomficher.doc
sGAC = Left(sNomFichier, vplan) 'on retire .doc se qui nous donne nomfichier
sClient = Left(sNomFichier, InStr(sNomFichier, ".") - 1) 'en supprimant tout ce qui est a droite du premier "." le "." inclus
sCheminFichier_New = "C:\Users\toto\Desktop\Gamme Excel_AC\" & sClient & "\"
If Dir(sCheminFichier_New, vbDirectory) = vbNullString Then
MkDir (sCheminFichier_New)
End If
Workbooks.Add 'on ouvre un classeur word vierge
Application.DisplayAlerts = False 'on désactive les alertes du à excel
'Puis on enregistre sous nomfichier.xlsx dans le dossier autocontrôle excel
ActiveWorkbook.SaveAs _
Filename:=sCheminFichier_New & sGAC & ".xlsx"
'------initialisation ------
Set wb = Workbooks.Open(sCheminFichier_New & sGAC & ".xlsx") 'on attribue une variable au classeur créé
Set ws = wb.Sheets(1) 'on attribue une variable à sa feuille
Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True 'ne pas afficher Word pendant l'exécution
Set WDoc = WApp.Documents.Open(sChemin & sNomFichier) 'ouvre le document Word
nbtab = WDoc.Tables.Count
'-----------------------récupération de données Word-----------------Tableau 1
'on détermine le test 1 si le fichier word possède une colonne "OP"
Cells(1, 10) = WDoc.Tables(1).Cell(5, 1).Range 'la valeur OP ou cote est renvoyée dans une case
test1 = Left(Cells(1, 10), Len(Cells(1, 10)) - 1) 'on supprime
Vop = Len(test1) 'on compte le nombre de caractères dans la variables test 1
Cells(1, 10).ClearContents 'on supprime ce qu'il se trouve dans la case
'---------------------Observations-------------------
'on récupère ce qu'il y a écrit dans les observations en supprimants les
ws.Cells(1, 5) = WDoc.Tables(1).Cell(2, 3).Range
ws.Cells(1, 5) = Left(ws.Cells(1, 5), Len(ws.Cells(1, 5)) - 1)
ws.Cells(2, 5) = WDoc.Tables(1).Cell(3, 4).Range
ws.Cells(2, 5) = Left(ws.Cells(2, 5), Len(ws.Cells(2, 5)) - 1)
'--------------------Initialisation boucle----------
i = 2
li = 7
Stp = 0
'---------------Condition Si Word Ancien-----------------
Cells(1, 10) = WDoc.Tables(1).Cell(5, 1).Range
test1 = Left(Cells(1, 10), Len(Cells(1, 10)) - 1)
Vop = Len(test1)
Cells(1, 10).ClearContents
If Vop > 3 Then
'--------------Mise en page-------------
Cells(1, 1) = "OP"
Cells(1, 2) = "Côte demandée"
Cells(1, 3) = "Moyen"
'-----------------Boucle----------------
Do While Stp < 4 'condition de sécurité la valeur peut être changer si besoin
'------------Lecture + Ecriture--------
ws.Cells(i, 2) = WDoc.Tables(1).Cell(li, 1).Range
ws.Cells(i, 2) = Left(ws.Cells(i, 2), Len(ws.Cells(i, 2)) - 1)
ws.Cells(i, 3) = WDoc.Tables(1).Cell(li, 2).Range
ws.Cells(i, 3) = Left(ws.Cells(i, 3), Len(ws.Cells(i, 3)) - 1)
'-----------Condition d'arret----------
If (IsEmpty(ActiveCell)) Then
Stp = Stp + 1
i = i - 1
ElseIf Cells(i, 2) = Cells(i - 1, 2) Then
Stp = Stp + 3
Cells(i, 1).ClearContents
Cells(i, 2).ClearContents
i = i - 1
End If
'--------Poursuite--------
li = li + 1
i = i + 1
Loop
'---------------Condition Sinon -------
Else
'--------------Mise en page-------------
Cells(1, 1) = "OP"
Cells(1, 2) = "Côte demandée"
Cells(1, 3) = "Moyen"
'-----------------Boucle----------------
Do While Stp < 4 'condition de sécurité la valeur peut être changer si besoin
'------------Lecture + Ecriture--------
ws.Cells(i, 1) = WDoc.Tables(1).Cell(li, 1).Range
ws.Cells(i, 1) = Left(ws.Cells(i, 1), Len(ws.Cells(i, 1)) - 1)
ws.Cells(i, 2) = WDoc.Tables(1).Cell(li, 2).Range
ws.Cells(i, 2) = Left(ws.Cells(i, 2), Len(ws.Cells(i, 2)) - 1)
ws.Cells(i, 3) = WDoc.Tables(1).Cell(li, 3).Range
ws.Cells(i, 3) = Left(ws.Cells(i, 3), Len(ws.Cells(i, 3)) - 1)
'-----------Condition d'arret----------
If (IsEmpty(ActiveCell)) Then
Stp = Stp + 1
ElseIf Cells(i, 2) = Cells(i - 1, 2) Then
Stp = Stp + 3
Cells(i, 1).ClearContents
Cells(i, 2).ClearContents
Cells(i, 3).ClearContents
i = i - 1
End If
'--------Poursuite--------
li = li + 1
i = i + 1
Loop
End If
'---------------------Fin récupération de données Word---------------Tableau 1
'condition 1
If nbtab <> 1 Then
For t = 2 To nbtab
Cells(i, 1) = "--------------------Page " & t & "--------------------"
Range("A" & i, "C" & i).Merge
'condition 2
test2 = WDoc.Tables(t).Cell(1, 1).Range
test2 = Left(test2, Len(test2) - 3)
If test2 = "MECABESS" Then
Stp = 0
li = 7
'on récupère ce qu'il y a écrit dans les observations en supprimants les
i = i + 1
ws.Cells(i, 5) = WDoc.Tables(t).Cell(2, 2).Range
ws.Cells(i, 5) = Left(ws.Cells(i, 5), Len(ws.Cells(i, 5)) - 1)
ws.Cells(i, 5) = WDoc.Tables(t).Cell(2, 3).Range
ws.Cells(i, 5) = Left(ws.Cells(i, 5), Len(ws.Cells(i, 5)) - 1)
'-----------------------récupération de données Word-----------------Tableau 2
If Vop > 3 Then
'--------------Mise en page-------------
Cells(1, 1) = "OP"
Cells(i, 1) = "Côte demandée"
Cells(i, 2) = "Moyen"
i = i + 1
'-----------------Boucle----------------
Do While Stp < 4 'condition de sécurité la valeur peut être changer si besoin
'------------Lecture + Ecriture--------
ws.Cells(i, 1) = WDoc.Tables(t).Cell(li, 1).Range
ws.Cells(i, 1) = Left(ws.Cells(i, 1), Len(ws.Cells(i, 1)) - 1)
ws.Cells(i, 2) = WDoc.Tables(t).Cell(li, 2).Range
ws.Cells(i, 2) = Left(ws.Cells(i, 2), Len(ws.Cells(i, 2)) - 1)
'-----------Condition d'arret----------
If (IsEmpty(ActiveCell)) Then
Stp = Stp + 1
i = i - 1
ElseIf Cells(i, 1) = Cells(i - 1, 1) Then
Stp = Stp + 3
Cells(i, 1).ClearContents
Cells(i, 2).ClearContents
i = i - 1
End If
'--------Poursuite--------
li = li + 1
i = i + 1
Loop
'---------------Condition Sinon -------
Else
'--------------Mise en page-------------
Cells(i, 1) = "OP"
Cells(i, 2) = "Côte demandée"
Cells(i, 3) = "Moyen"
i = i + 1
'-----------------Boucle----------------
Do While Stp < 4 'condition de sécurité la valeur peut être changer si besoin
'------------Lecture + Ecriture--------
ws.Cells(i, 1) = WDoc.Tables(t).Cell(li, 1).Range
ws.Cells(i, 1) = Left(ws.Cells(i, 1), Len(ws.Cells(i, 1)) - 1)
ws.Cells(i, 2) = WDoc.Tables(t).Cell(li, 2).Range
ws.Cells(i, 2) = Left(ws.Cells(i, 2), Len(ws.Cells(i, 2)) - 1)
ws.Cells(i, 3) = WDoc.Tables(t).Cell(li, 3).Range
ws.Cells(i, 3) = Left(ws.Cells(i, 3), Len(ws.Cells(i, 3)) - 1)
'-----------Condition d'arret----------
If (IsEmpty(ActiveCell)) Then
Stp = Stp + 1
ElseIf Cells(i, 2) = Cells(i - 1, 2) Then
Stp = Stp + 3
Cells(i, 1).ClearContents
Cells(i, 2).ClearContents
Cells(i, 3).ClearContents
i = i - 1
End If
'--------Poursuite--------
li = li + 1
i = i + 1
Loop
End If
Else
test3 = WDoc.Tables(2).Cell(1, 2).Range
If Len(test3) > 40 Then
test3 = Left(test3, Len(test3) - 20)
test3 = Right(test3, Len(test3) - 20)
End If
If test3 = "AUTO-CONTROLE INTERNE" Then
Stp = 0
li = 4
'--------------Mise en page-------------
Cells(i, 1) = test3
i = i + 1
Cells(i, 1) = "Freq"
Cells(i, 2) = "Côte demandée"
Cells(i, 3) = "Moyen"
i = i + 1
'-----------------Boucle----------------
Do While Stp < 4 'condition de sécurité la valeur peut être changer si besoin
'------------Lecture + Ecriture--------
ws.Cells(i, 1) = WDoc.Tables(t).Cell(li, 1).Range
ws.Cells(i, 1) = Left(ws.Cells(i, 1), Len(ws.Cells(i, 1)) - 1)
If InStrRev(ws.Cells(i, 1), "OP") = 0 Then
ws.Cells(i, 2) = WDoc.Tables(t).Cell(li, 2).Range
ws.Cells(i, 2) = Left(ws.Cells(i, 2), Len(ws.Cells(i, 2)) - 1)
ws.Cells(i, 3) = WDoc.Tables(t).Cell(li, 3).Range
ws.Cells(i, 3) = Left(ws.Cells(i, 3), Len(ws.Cells(i, 3)) - 1)
End If
'-----------Condition d'arret----------
If (IsEmpty(ActiveCell)) Then
Stp = Stp + 1
ElseIf Cells(i, 2) = Cells(i - 1, 2) Then
Stp = Stp + 3
Cells(i, 1).ClearContents
Cells(i, 2).ClearContents
Cells(i, 3).ClearContents
i = i - 1
End If
'--------Poursuite--------
li = li + 1
i = i + 1
Loop
End If
End If
Next t
End If
'---------------------Fin récupération de données Word---------------Tableau 2
'boucle d'analyse d'erreur du à la non détection de caractère spéciaux
For a = 2 To i
If InStrRev(Cells(a, 2), "") <> 0 Then
ActiveWorkbook.SaveAs _
Filename:=sCheminFichier_New & "erreurlocale" & sGAC & ".xlsx"
ActiveWorkbook.Close SaveChanges:=True
Kill (sCheminFichier_New & sGAC & ".xlsx")
Exit For
ElseIf a = i And InStrRev(Cells(a, 2), "") = 0 Then
ActiveWorkbook.Close SaveChanges:=True
Exit For
End If
Next a
Application.DisplayAlerts = True
WDoc.Close False 'fermer le document Word sans enregistrer
WApp.Quit 'Fermer l'instance de Word
sNomFichier = Dir("") 'prochain document
Loop
End SubBonjour,
Merci de mettre un titre de sujet qui est en rapport avec votre demande.
"je ne sais pas où est mon erreur " c'est pas très explicite
Pensez à prendre un peu de temps pour lire ces quelques lignes si vous ne l'avez pas encore fait --> https://forum.excel-pratique.com/excel/a-lire-avant-de-poster-charte-du-forum-et-informations-utiles...
Merci de votre compréhension
Cordialement
Invité
Bonjour Arkantos,
Nous donner le code comme cela, ne sert à rien
Lorsque la fenêtre de bug apparait, cliquez sur débogage, vous arriverez alors sur VBAproject
faites alors une capture de la ligne surlignée en jaune
Edit : salut l'ami Dan
A
Merci je saurais pour les prochaine fois
voila la ligne avec l'erreur obtenue sachant que le fichier n'existe pas
Bonjour,
A mon avis, il y a un souci d'extension : c'est .doc ou .xls ? En tout cas, peu probable que ce soit .doc.xls !