Microsoft 365 Erreur sur mon Code VBA

  • Initiateur de la discussion Initiateur de la discussion Madi123
  • Date de début Date de début
  • Mots-clés Mots-clés
    vba

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Madi123

XLDnaute Nouveau
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
 

Pièces jointes

  • certificat.png
    certificat.png
    31.6 KB · Affichages: 18
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
334
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
46
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
622
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
482
Réponses
3
Affichages
569
Réponses
9
Affichages
368
Réponses
5
Affichages
380
  • Question Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
365
Retour