Microsoft 365 Erreur sur mon Code VBA

[Madi123]

Bonjour. J'ai un document Excel sur lequel je travaille pour générer un certificat de conformité pour nos véhicules. Avant, nous le faisions avec le publipostage, mais depuis quelques semaines, nous avons fait appel à une personne pour nous aider à automatiser tout cela avec VBA. Maintenant, après avoir renseigné toutes les informations nécessaires dans le fichier Excel concernant un véhicule donné, nous sélectionnons la ligne où ces informations sont répertoriées pour générer le document en format PDF. Comme vous pouvez le voir sur l'image, après avoir renseigné les cellules de la ligne, qui concernent donc un véhicule bien déterminé, j'appuie sur l'un des boutons "Intyg" ou "Miljödeklaration" selon le document que je souhaite émettre et j'obtiens le document en format PDF.

Cela fonctionne pour le document "Intyg" mais pas pour le document "Miljödeklaration". Pour ce dernier, j'obtiens le document de la dernière ligne même si je ne sélectionne aucune ligne au préalable.

Je sollicite votre aide pour corriger cette erreur. Voici les codes.

Option Explicit
Public Const wdFindContinue = 1
Public Const wdReplaceAll = 2
Public Const wdStatisticPages = 2


Sub INTYG()
Dim FacLigne, FacCol As Long
Dim Modèle, Variable, VarValeur, NomFichier, Dossier, SousDossier, DateStr As String
Dim WordDoc, WordApp As Object

With Blad1

If Feuil1.Range("B3").Value = Empty Then
MsgBox "Lägg till mallen i Word-format"
Feuil1.Range("B3").Select
Exit Sub
End If

Modèle = Feuil1.Range("B3").Value

On Error Resume Next
Set WordApp = GetObject("Word.Application")

If Err.Number <> 0 Then
Err.Clear
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
End If

FacLigne = Selection.Row

Set WordDoc = WordApp.Documents.Open(FileName:=Modèle, ReadOnly:=False)

WordApp.ScreenUpdating = False
WordApp.DisplayAlerts = 0

For FacCol = 1 To 219
Variable = .Cells(1, FacCol).Value
VarValeur = .Cells(FacLigne, FacCol).Value

With WordDoc.Content.Find
.Text = Variable
.Replacement.Text = VarValeur
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll

End With
Next FacCol


Dossier = Feuil1.Range("Dossier").Value
SousDossier = Dossier & "\5030-" & .Range("A" & FacLigne).Value
If Dir(SousDossier, vbDirectory) = "" Then
MkDir SousDossier
End If

'DateStr = Format(Date, "yyyy-mm-dd")
NomFichier = SousDossier & "\Intyg om överensstämmelse " & .Range("A" & FacLigne).Value & ".pdf"
WordDoc.ExportAsFixedFormat OutputFileName:=NomFichier, ExportFormat:=17
WordDoc.Close False
Shell "explorer.exe " & NomFichier, vbNormalFocus

WordApp.ScreenUpdating = True
WordApp.DisplayAlerts = -1

WordApp.Quit
End With
End Sub


Sub Miljödeklaration()
Dim FacLigne, FacCol As Long
Dim Modèle, Variable, VarValeur, NomFichier, Dossier, SousDossier, DateStr As String
Dim WordDoc, WordApp As Object

With Blad1

If Feuil1.Range("B5").Value = Empty Then
MsgBox "Lägg till mallen i Word-format"
Feuil1.Range("B5").Select
Exit Sub
End If

Modèle = Feuil1.Range("B5").Value

On Error Resume Next
Set WordApp = GetObject("Word.Application")

If Err.Number <> 0 Then
Err.Clear
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
End If

FacLigne = Selection.Row

Set WordDoc = WordApp.Documents.Open(FileName:=Modèle, ReadOnly:=False)

WordApp.ScreenUpdating = False
WordApp.DisplayAlerts = 0

For FacCol = 1 To 219
Variable = .Cells(1, FacCol).Value
VarValeur = .Cells(FacLigne, FacCol).Value

With WordDoc.Content.Find
.Text = Variable
.Replacement.Text = VarValeur
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll

End With
Next FacCol

Dossier = Feuil1.Range("Dossier").Value
SousDossier = Dossier & "\Miljödeklaration " & .Range("A" & FacLigne).Value
If Dir(SousDossier, vbDirectory) = "" Then
MkDir SousDossier
End If


'DateStr = Format(Date, "yyyy-mm-dd")
NomFichier = SousDossier & "\" & "Miljödeklaration 5030-" & .Range("B" & FacLigne).Value & ".pdf"
WordDoc.ExportAsFixedFormat OutputFileName:=NomFichier, ExportFormat:=17
WordDoc.Close False
Shell "explorer.exe " & NomFichier, vbNormalFocus

WordApp.ScreenUpdating = True
WordApp.DisplayAlerts = -1

WordApp.Quit
End With
End Sub

 

[vgendron]

Bonjour

Si l'aide est toujours souhaitée.. il serait bon de poster un fichier excel plutot qu'une image dont on ne peut rien faire et qui n'apporte aucune info utile
le fichier doit etre évidemment anonymisé : pas de donnée confidentielle, remplacées par des données bidons

 

[Gégé-45550]

Avant, nous le faisions avec le publipostage, mais depuis quelques semaines, nous avons fait appel à une personne pour nous aider à automatiser tout cela avec VBA.

Bonjour,
Pourquoi ne pas demander à la personne qui a écrit le VBA de corriger son code ?
Cordialement,