XL 2019 Insérer logos via userform excel dans word

CBX

XLDnaute Nouveau
Bonjour à tous,
Cela fait une semaine que je m'arrache les cheveux sans succès..... la calvitie me guette !!!

Je dois réaliser un petit programme VBA pour faciliter la saisie des contrats dans word (en fait en pdf mais bref, ce n'est pas vraiment le sujet). Jusqu'à présent tout va bien. J'en suis à essayer d'insérer le logo en fonction de la valeur d'un combobox.
En résumé, lorsque l'utilisateur sélectionne "Chien" dans la liste du userform, alors une ligne vient alimenter une base de données, le mot "Chien" s'affiche bien sur le document word, et il faudrait que l'image du Chien apparaisse dans le signet du document word.
Les logos sont stockés dans un sous dossier
Bien sur nous avons aussi des chats et des poules, donc il faudrait que le logo soit en fait relié à la combobox "Animal".
Est ce que que quelqu'un peut m'aider à résoudre cela ?

Grand merci d'avance
 

Pièces jointes

  • TestLogo.xlsm
    121.3 KB · Affichages: 4
  • TestLogo.docx
    28.8 KB · Affichages: 8
  • Logo.zip
    531.8 KB · Affichages: 5

CBX

XLDnaute Nouveau
Bonjour fanch55,

1 milliard de merci pour votre fichier. Lorsque je le lance "tel quel" il fonctionne parfaitement et correspond à ce que je souhaite faire. Par contre, lorsque j'essaie de l'intégrer dans mon fichier (en reprenant à peu près ce que j'avais déjà fait, j'ai un message d'erreur sur cette ligne :
With .InlineShapes.AddPicture(ThisWorkbook.Path & "\Logo\" & CboxAnimal & ".jpg")


Voci "mon code" en entier :


VB:
Sub GenererDocument()

Dim wordapp As Word.Application
Dim worddoc As Word.Document
Dim W As Long, H As Long
Dim Derligne As Integer
Dim F As Worksheet
Dim TIC As Range
Const wdExportFormatPDF = 17
          

Set wordapp = CreateObject("Word.application")
Set worddoc = wordapp.Documents.Open(ThisWorkbook.Path & "\TestLogo.docx")


Set F = ThisWorkbook.Sheets("Animal")
'Set TIC = Range("C" & Derligne).Value

'Derligne = F.Range("C" & Rows.Count).End(xlUp).Row


worddoc.Bookmarks("Animal").Range.Text = CboxAnimal
    With worddoc.Bookmarks("Logo").Range

        With .InlineShapes(1)
         W = .Width
         H = .Height
        
         .Delete
        End With
        
        With .InlineShapes.AddPicture(ThisWorkbook.Path & "\Logo\" & CboxAnimal & ".jpg")
        .Width = W
        .Height = H
        End With
        
    End With


'TIC = "Chat"
    
        'worddoc.Bookmarks("Texte").Range.Text = Sheets("Parametres").Range("A19")

    
wordapp.Visible = False


worddoc.ExportAsFixedFormat _
    OutputFileName:=ThisWorkbook.Path & "\_" & ".pdf", _
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True
    
        '"_" & ".pdf", ExportFormat:= _
        '17, OpenAfterExport:=True, OptimizeFor:= _
        '0, Range:=0, From:=1, To:=1, _
        'Item:=0, IncludeDocProps:=True, KeepIRM:=True, _
        'CreateBookmarks:=0, DocStructureTags:=True, _
        'BitmapMissingFonts:=True, UseISO19005_1:=False


    
    worddoc.Close SaveChanges:=False
    
    wordapp.Quit 'Ferme la session word
    
    End Sub

Pouvez vous m'aider à adapter ce code ?
Encore merci à vous,
 

fanch55

XLDnaute Barbatruc
Remplacez la sub par celle-ci dessous
Si erreur, dites-moi quel est le message d'erreur indiqué
VB:
Sub GenererDocument()

Dim WordApp As Object ' Word.Application
Dim WordDoc As Object ' Word.Document
Dim W As Long, H As Long
Dim Logo_Folder As String, Word_File As String
Const wdExportFormatPDF = 17

    Logo_Folder = ThisWorkbook.Path & "\Logo\"
    Word_File = ThisWorkbook.Path & "\TestLogo.docx"
    
    Select Case True
    Case CboxAnimal.Text = "":                         MsgBox "Un logo doit être indiqué"
    Case Dir(Logo_Folder, vbDirectory) = "":           MsgBox "Le dossier des logos n'a pas été trouvé"
    Case Dir(Word_File) = "":                          MsgBox "Le fichier word n'a pas été trouvé"
    Case Dir(Logo_Folder & CboxAnimal & ".jpg") = "":  MsgBox "Le logo n'a pas été trouvé"
    Case Else
        Set WordApp = CreateObject("Word.application")
            Set WordDoc = WordApp.Documents.Open(Word_File)
            
                WordDoc.Bookmarks("Animal").Range.Text = CboxAnimal
                With WordDoc.Bookmarks("Logo").Range
                    With .InlineShapes(1)
                        W = .Width
                        H = .Height
                       .Delete
                    End With
                    With .InlineShapes.AddPicture(Logo_Folder & CboxAnimal & ".jpg")
                        .Width = W
                        .Height = H
                    End With
                End With
                
                WordDoc.ExportAsFixedFormat _
                    OutputFileName:=ThisWorkbook.Path & "\_" & ".pdf", _
                    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True
            
            WordDoc.Close SaveChanges:=False
        WordApp.Quit 'Ferme la session word
        Set WordApp = Nothing
    End Select
    
End Sub
 

CBX

XLDnaute Nouveau
Bonjour fanch55,

C'est vraiment très très gentil à vous de m'aider. En fait, je crois que j'ai compris ce que je n'arrive pas à faire : dans votre première proposition, tous les codes sont dans le bouton "Ajouter" dans le Userform.
Cependant, pour ce projet, nous devons séparer la saisie des informations du formulaire dans la base de données excel (1er temps avec le userform). La BDD vient ensuite faire tourner quelques formules pour insérer des informations complémentaires (on dira 2nd temps, pour éviter des ressaisies), et dans un troisième temps, l'utilisateur et après contrôle viendra éditer (générer) le document. Et c'est là que je pense louper quelque chose : je n'arrive pas à faire fonctionner le code dans un nouveau module "GénérerDocument" et y affecter un bouton sur l'onglet de la base de données.
J'ai réussi à tout faire fonctionner (il y a une vingtaine de champs dans le formulaire et une trentaine de signets qui se remplissent correctement dans le document word/pdf, mais je suis complétement bloquée pour l'insertion des logos.
Je vous transmets le fichier si cela peut mieux vous aider à m'aider.
Merci encore
 

Pièces jointes

  • TestLogo.xlsm
    26.1 KB · Affichages: 1

Discussions similaires

Statistiques des forums

Discussions
312 817
Messages
2 092 372
Membres
105 381
dernier inscrit
stephan57