Bonjour à tous, je suis nouveau sur le forum et dans la programmation VBA mais avec quelques notions.
J'ai un problème dans ma programmation VBA Excel.
J'explique mon projet :
Je souhaite Ouvrir automatiquement un Modèle (Word), en double-cliquant sur une cellule dans mon tableur Excel.
Seulement J'ai une erreur de compilation : Type défini par l'utilisateur non défini.


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Private moFSO As FileSystemObject
 
Public Sub GenererConvoc(piLig As Integer)
 
    Dim iRep As VbMsgBoxResult
    Dim sModele As String
    Dim oShSource As Worksheet
    Dim oWAFinal As WordApplication
    Dim oWDFinal As WordDoc
    Dim sNomPrenom As String
 
    Dim sFichierFinal As String
 
    sModele = This.Document.Path & "\" & "Convocation.docx"
 
    If Dir(sModele) = "" Then
        MsgBox "Modèle absent : " & vbCrLf & sModele, vbExclamation
        Exit Sub
    End If
 
    Set oShSource = Worksheets("Programme")
 
    sNomPrenom = oShSource.Range("A" & piLig).Value
 
    sFichierFinal = ThisDocument.Path & "\" & sNomPrenom & ".docx"
 
    If Dir(sFichierFinal) = "" Then
        iRep = MsgBox("Voulez-vous générer le bon pour le client [" & sNomPrenom & "] ?", vbOKCancel + vbExclamation)
    Else
       iRep = MsgBox("Un bon existe déjà pour le client [" & sNomPrenom & "] : " & vbCrLf & vbCrLf & sFichierFinal & vbCrLf & vbCrLf & _
                "Voulez-vous le remplacer ?", vbOKCancel + vbExclamation)
    End If
 
    If iRep <> vbOK Then
        Exit Sub
    End If
 
    Set moFSO = New FileSystemObject
 
    'copie du modèle
    moFSO.CopyFile sModele, sFichierFinal, True
 
    'ouverture fichier final
    Set oWAFinal = Word.Open(sFichierFinal)
 
    Set oWDFinal = oWAFinal.Worksheets(1)
 
    'alimentation du fichier final
    'MsgBox "Alimentation !"
    WordDoc.Fields(1).Result.Text = oShSource.Range("A" & piLig).Value 'Nom Prénom
    WordDoc.Fields(2).Result.Text = oShSource.Range("B" & piLig).Value 'Adresse
 
    'save + fermeture
    oWAFinal.Save
    'oWBFinal.Close
 
    Set oWDFinal = Nothing
    Set oWAFinal = Nothing
    Set moFSO = Nothing
 
    Set oShSource = Nothing
 
    MsgBox "Le bon est disponible !" & vbCrLf & vbCrLf & sFichierFinal, vbInformation, "Bon disponible !"
 
 
End Sub
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    If Target.Column = 1 Then
        If Target.Value <> "" Then
            GenererConvoc Target.Row
        End If
    End If
Si quelqu'un découvre des anomalies, merci de me l'indiquer.
Restant dans l'attente d'une réponse positive.
Cordialement,