Commande taille image dans word depuis Excel

[MH54]

Bonjour,

Je souhaite réaliser un rapport automatique sous Word (pour garantir une certaine mise en page du texte etc… )
Par contre beaucoup de module sont de type table de calcul avec des formules compliqués sous Excel.

Cette première partie donne la manière que j’utilise à l’heure actuelle (elle fonctionne), la question est plutôt en point 2

1/
Pour le moment, je ne sais pas si c'est la meilleur solution mais cela fonctionne, j'utilise des signets sous Word où je veux insérer une image EXCEL et coller l’image en métafichier. Cela correspond des choses comme cela :

Set ww = CreateObject("word.application") 
ww.Visible = True
ww.Documents.Open Filename:=ActiveWorkbook.Path & "\TRAM NOTE FRANCAIS\" & "TRAM note francais.doc"

‘pour mettre la date, la révision du rapport, enfin du texte (sans cellule autour t avec la mise en form word et non excel) d'un côté nom de signet word de l'autre nom de plage ou cellule excel etc… :

ww.ActiveDocument.Bookmarks("note_rev").Range = ActiveWorkbook.Names("note_rev").RefersToRange.Value
ww.ActiveDocument.Bookmarks("note_date").Range = ActiveWorkbook.Names("note_date").RefersToRange.Value 


‘Pour insérer une plage appelé note_roulement_carac dans EXCEL au signet roulement_carac dans Word en méta fichier (dans le texte et non en vrac au-dessus du texte): 

ww.ActiveDocument.Bookmarks("roulement_carac").Select
ActiveWorkbook.Names("note_roulement_carac").RefersToRange.Copy
ww.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
ww.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

Ceci était pour le contexte et pour donner le code sur lequel j'ai déjà pas mal buché malgré pas mal de rubrique d’aide sur internet…

2/
Maintenant ma question:
je souhaite redimensionner l'image métafichier, j'ai trouvé un code qui fonctionne sous word (si je prends un nouveau fichier et ne colle des images) mais pas sous excel.
Il faut noter que la seul façon que j'ai trouvé nécessite de connaitre le n° d'index de l'inlineshape (forme dans le texte crée en collant en métafichier). Or il y a plein d'images je n'ai aucune idée de cet index.

Le code qui ne marche dans word donne:
[/CODE]
Sub AA()
Dim i As Integer
i = ActiveDocument.InlineShapes.Count
Word.ActiveDocument.InlineShapes(i).Height = 55
Word.ActiveDocument.InlineShapes(i).Width = 25

End Sub
[/CODE]

Pour excel, je pensais arriver à quelque chose comme cela :
[/CODE]
Sub AA()

Set ww = CreateObject("word.application")
ww.Visible = True
ww.Documents.Open Filename:=ActiveWorkbook.Path & "\TRAM NOTE FRANCAIS\" & "TRAM note francais.doc"
Dim i As Integer
i = ww.ActiveDocument.InlineShapes.Count
ww.ActiveDocument.Bookmarks("roulement_carac").Select
ActiveWorkbook.Names("note_roulement_carac").RefersToRange.Copy
ww.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
ww.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

ww.ActiveDocument.InlineShapes(i).Height = 55
ww.ActiveDocument.InlineShapes(i).Width = 25
End Sub
[/CODE]

Mais les commandes ne font rien du tout....

Je ne sais plus quoi faire d'autre à part les reprendre à la main, et à ce stade c'est domage...

Merci pour votre aide

 

[MH54]

Re : Commande taille image dans word depuis Excel

Bon, j'ai trouvé quelque chose, c'est de la bidouille mais bon...

[/CODE]

ww.ActiveDocument.Bookmarks("BC_fix_verif2").Select ' aller au signet dans word pour voir ce qui s'y passe en direct
ww.ActiveDocument.Bookmarks("BC_fix_verif2").Range.Delete 'enlever l'ancienne image
ActiveWorkbook.Names("note_BC_fix_verif2").RefersToRange.Copy
ww.ActiveDocument.Bookmarks("BC_fix_verif2").Range.Select
ww.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine ' mettre la nouvelle

ww.ActiveDocument.Bookmarks("BC_fix_verif2").Select 'retourner au signer
ww.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend 'étendre la selection en avancant le curseur
With ww.Selection.InlineShapes(1) ' redimensionner la selection : l'image inline shape...
.Height = 1 ' hauteur
.Width = 10# 'largeur
End With
[/CODE]


Si vous avez des idées pour amélorer le code... je vous remercie par avance.

MH

 

[MH54]

gestion d'erreur renvoi vers n° de ligne variable

Bonjour à tous,

J'aurais besoin d'une précision pour faire suite à "Re : Commande taille image dans word depuis Excel "

Besoin :
Lorsque j'exécute mes macro de copie/colle d'Excel vers Word, cela peut boguer en raison de la mise en forme dans Word: s'il faut déplacer un saut de page ou du texte pour insérer l'image en provenance d’Excel par exemple (c'est à dit presque tt le temps).

en gros lorsque cela plante, il faut prendre le curseur (flèche jaune du déboguer) le monter de deux ligne et relancer...
Parfois il faut le faire 2-3 fois mais cela fini par marcher...

Autant dire que c'est ..."fatiguant"...

Idée1 :
Pourrait on fait un truc du genre :
On Error GoTo """ deux ligne au-dessus de là où tu plante""" mais je ne trouve pas comment ?

J'ai trouvé
On Error Go ErrorHandler
""" la série de copie colle """

Exit Sub
ErrorHandler:
Goto ""ligne du contrôle -2""" <-C'est là que je suis perdu

Resume Next
End Sub

Une solution complémentaire serait de prendre un index type i.
On commence à i=0 et incrémente de 1 après chaque image collée.

Par contre je ne sais pas comment renvoyer vers une étiquette dont le nom est variable. "i" d'ailleurs ne constitue par une étiquette ou un n° de ligne pour VBA.


Ma compréhension de VBA ne me permet pas d'aller plus loin... (il me manque encore certaine bases)

Pourriez-vous me donner un coup de pouce ou une direction à prendre?

Merci par avance.

MH

 

[MH54]

Re : Commande taille image dans word depuis Excel

Re-bonjour,

j'ai trouvé ceci mais c'est lourd:

ub export_image_de_plage()
Dim ww As Word.Application
Dim WordDoc As Word.Document
Dim bypass As Boolean
Dim FLAG_BAB As Integer
Dim FLAG_niv1 As Integer
Dim FLAG_niv2 As Integer
Dim Name As String
Dim Flag_Error  As Boolean
Dim anti_boucle_infini As Integer

'name = ActiveWorkbook.Sheets("ENTREE").Range("D5")
Set ww = CreateObject("word.application")    'vre une session Word

ww.Visible = True    'FALSE: Word est masqué pendant l'opération'TRUE:affiche le document Word
bypass = 1
Flag_Error = False
anti_boucle_infini = 0


If ActiveWorkbook.Names("Langue").RefersToRange.Value = 1 Then
        ww.Documents.Open Filename:=ActiveWorkbook.Path & "\TRAM note 1.doc"
Else
        ww.Documents.Open Filename:=ActiveWorkbook.Path & "\TRAM note 2.doc"
End If

On Error GoTo ErrorHandler

ww.ActiveDocument.Bookmarks("DOC_REF").Range.Delete
1 ActiveWorkbook.Names("note_DOC_REF").RefersToRange.Copy
ww.ActiveDocument.Bookmarks("DOC_REF").Range.Select
Flag_Error = 0
ww.Selection.PasteSpecial , DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
If Flag_Error = 1 Then GoTo 1
ww.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
ww.ActiveDocument.Bookmarks("DOC_REF").Select
ww.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
  With ww.Selection.InlineShapes(1)    'adapter l'index si d'autres images existantes dans le document
        .Height = 10.22 / 0.035304 'changement dimension image insérée : hauteur
        .Width = 15.34 / 0.035304  'largeur
   End With

........ Plein de bloc copie/colle.................


Exit Sub
 
ErrorHandler:

Flag_Error = 1
anti_boucle_infini = anti_boucle_infini + 1

If anti_boucle_infini > 500 Then GoTo endsub

'MsgBox Err.Number & vbLf & Err.Description         'affinche un box avec n° d'erreur mais cela fonctionne avec...

If Err.Number = 4605 Then Resume Next Else

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = " un erreur non gérée est arrivée"    ' Définit le message.
Style = vbOK + vbCritical + vbDefaultButton2    ' Définit les boutons.
Title = "erreur inconnue fin de l'appli "    ' Définit le titre.
Help = "DEMO.HLP"    ' Définit le fichier d'aide.
Ctxt = 1000    ' Définit le contexte de
                ' la rubrique.
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
GoTo endsub

endsub: End Sub

Par contre, s'il est possible de fair "resume next" c'est bien que quelque part, il y a le n0 de la ligne qui a planté...
il faudrait prendre le n° fair -2 et faire

ErrorHandler:
line= "la fameuse variable où il y a le numéro de ligne qui a planté" -2
resume line

Avez vous une idée.??

Merci par avance

MH