jeanmi
XLDnaute Occasionnel
Bonjour à tous,
Aujourd’hui j’utilise la procédure qui suit pour faire l’opération de collage de mes images afin qu’elles soient à la bonne taille et bien positionnées dans mon doc Word.
J’ai récupéré le code généré automatiquement par Word pour le mettre dans ma macro sous Excel.
je suis avec office 2010
Procédure utilisée :
-1- Insertion, formes, rectangles
-2- je positionne mon rectangle à l’emplacement et la taille souhaité
-3- remplissage, blanc
-4- contour, sans conteur
-5-clic droit format de la forme ou styles de formes , je sélectionne, remplissage avec image ou texte
-6- je clic sur fichier dans la fenêtre et je sélectionne mon fichier en pgn ou jpg, puis insérer et fermer
Mon image est bien à la taille et l’emplacement souhaité dans le doc.
Ma Question :
Est-il possible de réaliser cette opération en code VBA pour faire réaliser cette opération à partir d’Excel. (mon fichier Word est renseigné au niveau signets avec des infos de cellules Excel et donc je voudrais ajouter l’image dans ma procédure)
voici le code utilisé, merci à @herve62 pour l'aide à la mise au point de ce code qui fonctionne très bien.
j'ai ajouter ce code , donc entre les deux codes ci-dessus et celui plus bas qui fonctionné très bien à partir du doc Word , j'ai un message d'erreur sur " Selection.InlineShapes.AddPicture Filename:= ......."
suite du code :
Merci pour vos réponses
Cordialement
Aujourd’hui j’utilise la procédure qui suit pour faire l’opération de collage de mes images afin qu’elles soient à la bonne taille et bien positionnées dans mon doc Word.
J’ai récupéré le code généré automatiquement par Word pour le mettre dans ma macro sous Excel.
je suis avec office 2010
Procédure utilisée :
-1- Insertion, formes, rectangles
-2- je positionne mon rectangle à l’emplacement et la taille souhaité
-3- remplissage, blanc
-4- contour, sans conteur
-5-clic droit format de la forme ou styles de formes , je sélectionne, remplissage avec image ou texte
-6- je clic sur fichier dans la fenêtre et je sélectionne mon fichier en pgn ou jpg, puis insérer et fermer
Mon image est bien à la taille et l’emplacement souhaité dans le doc.
Ma Question :
Est-il possible de réaliser cette opération en code VBA pour faire réaliser cette opération à partir d’Excel. (mon fichier Word est renseigné au niveau signets avec des infos de cellules Excel et donc je voudrais ajouter l’image dans ma procédure)
voici le code utilisé, merci à @herve62 pour l'aide à la mise au point de ce code qui fonctionne très bien.
VB:
Sub creation_BL()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application, WordDoc As Word.Document
Dim i&, j&, x1&, pos&, NomDoc$, celle_qu$, s As Object
Dim chemin As String
'Application.EnableEvents = False
' avoir ou et s'il faut mettre cette instruction normalement utilisée pour modifier des doc par VBA sans retirer la protection de l'ongle?
Cells(4, 3).Select
Application.ScreenUpdating = False
'On Error Resume Next
' ON REMPLI SEULEMENT LA PAGE DE GARDE
'***************************************
num_actif_onglet = ActiveSheet.Index
dg = Sheets(num_actif_onglet).Range("A100").End(xlUp).Row ' affecte à dg la valeur de la dernière ligne (non vise) dans la colonne Ajusqu'à 65
For x = 4 To dg
indic = Cells(x, 1)
Select Case indic
Case "Editer"
GoTo suite1
' test si des croix dans le cases interdites
Case "x"
celle_qu = Cells(x, 2)
For x1 = 1 To celle_qu
cellule_D = Cells(x, 9).Value 'cellule date code I/dg
cellule_N = Cells(x, 3).Value 'cellule nom C/dg
cellule_P = Cells(x, 4).Value 'cellule prénom D/dg
fic = cellule_N & "-" & cellule_P & "_" & x1 & "-" & celle_qu & "_Bon de livraison" 'Nom du nouveau fichier créé
Set WordApp = CreateObject("word.application")
chemin = "C:\Users\HP\Documents\04-documentation pour OP"
NomDoc = chemin & "\" & fic & ".docm" ' définition du chemin et nom du doc au créer
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & "05-Bon de livraison-V12.docm")
WordDoc.SaveAs NomDoc ' On l'enregistre ? là le doc est vide ?
' ***** boucle qui renseigne le document Wort à partir du fichier Excel *****
For i = 1 To 9
Set s = WordDoc.Bookmarks("Texte" & i) ' affecte le texte/i à la variable s
If s Is Nothing Then GoTo suite
WordDoc.Activate
s.Select
WordApp.Options.ReplaceSelection = True
WordApp.Selection.TypeText Cells(x, i + 2) ' dg = la ligne qui est traitée avec i+2 la colonne
pos = WordApp.Selection.Range.End
Set s = WordDoc.Range(pos - Len(Cells(x, i + 2)), pos)
WordDoc.Bookmarks.Add "Texte" & i, s
On Error GoTo 0
suite:
Next i
' *** Traitement des cases à cocher ***
Vcit = Cells(x, 15)
WordDoc.FormFields("CaseACocher2").CheckBox.Value = True
j'ai ajouter ce code , donc entre les deux codes ci-dessus et celui plus bas qui fonctionné très bien à partir du doc Word , j'ai un message d'erreur sur " Selection.InlineShapes.AddPicture Filename:= ......."
VB:
WordDoc.Bookmarks("signatureBL").Range.Text = " sig"
chemin_sig = "C:\Users\HP\Documents\Dossier pour gestion des OP\2021-08-31-frederic-OP1 JAUNE\"
nom_sig = cellule_N & " " & cellule_P & " Signature.png"
MsgBox " chemin image et nom fichier " & chemin_sig & nom_sig
Selection.InlineShapes.AddPicture Filename:= _
chemin_sig & nom_sig _
, LinkToFile:=False, SaveWithDocument:=True
suite du code :
Code:
' On va créer le PDF ici
' =======================
Set wDoc = WordApp.ActiveDocument
T_PDF = fic 'c'est la définition du nom du doc
FicPDF = chemin & "\" & fic & ".pdf"
wDoc.ExportAsFixedFormat OutputFileName:=FicPDF, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=True
WordDoc.Close True
WordApp.Quit
Next x1
Cells(x, 22).Value = "Editer_BL" 'remplace le x de la colonne 1 par Editer
Case Else
GoTo suite1
suite1:
End Select
'***** Fin de la boucle de remplissage du doc Word *****
Next x ' retour pour vérifier s'il y a encore des donnée à traiter
Beep
Application.ScreenUpdating = True
End Sub
Merci pour vos réponses
Cordialement
Dernière édition: