Adapter la largeur d'un objet collé issu d'Excel

Version imprimable

Bonjour à tous ! :mrgreen:

Dans le but de progresser sur ma macro d'export Excel sur Word, je cherche à avancer petit à petit.

Au stade oû j'en suis j'arrive à exporter les bons éléments !

(Je créer d'abord des plages nommées selon la mise en page prévu sur excel, puis je copie-colle avec liaison ces plages nommées sur Word)

Voici le code actuel :

Code:

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
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function
 
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 ' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
 ' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
 
For n = 1 To 3
    If exist("En_tête", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("En_tête").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9
    End If
Next
 
For n = 1 To 15
    If exist("Descriptif", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Descriptif").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
For n = 1 To 5
    If exist("Carac_tech", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Carac_tech").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
 
End Sub

Je souhaiterais maintenant régler la largeur de mes exportations :P
Il faudrait que mes objets collés fasse la même largeur que la largeur de ma page Word. (Ca peut se faire en copiant "l'entre-marge" actuel ou en indiquant directement la largeur en valeur)
Je souhaite modifier la largeur parce que la largeur de ma source ne change pas, contrairement à sa longueur. Donc en gardant les proportions et en adaptant la largeur, on tombe juste.

Avec l'enregistreur de macro Word j'obtiens des lignes intéressantes :

Code:

1
2
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 498.9

Mais qui évidemment ne fonctionne pas si je l'insère dans ma macro :calim2:

Je précise que j'ai peu d'aptitude à la création de macro, j'arrive juste à modifier/adapter des bouts de code existants. :aie:

07/08/2019, 15h55
Invité

Citation:

Envoyé par Anthony47

Bonjour,

Il faut que votre objet Selection soit un objet Word.Selection si vous l'utilisez depuis Excel.

Sinon regardez le #47 de cette discussion : importer-tableau-d-excel-sous-word-sous-format-image-partir-word
07/08/2019, 16h32
Anthony47

Bonjour Eric,

Merci pour votre réponse, le lien que vous m'avez envoyé semble traiter exactement de ce sujet ! :)

Par contre ça va pas être simple à extraire ^^'

Je rajoute quoi sur ma macro ?
07/08/2019, 17h02
Invité

Citation:

Envoyé par Anthony47

Dans mon code, je transforme certaines images de la collection InLineShapes en objets Shape avec la commande ConvertToShape au fur et à mesure. Les dimensions de ces formes peuvent ensuite être modifiées. Comme indiqué, si Word est paramétré pour que les formes restent proportionnelles, il suffit de n'agir que sur la largeur.

Une fois votre document entièrement réalisé, combien d'InlineShapes avez-vous ? Compter le nombre avant si vous partez d'un modèle et le nombre après injection.
Je pense qu'en réalisant une boucle à la fin de votre code sur cette collection vous devriez y arriver.
07/08/2019, 17h18
Anthony47

J'ai entre 3 et 20 objets.

Je ne pars pas d'un modèle, le fichier est généré par la macro.

Citation:

Je pense qu'en réalisant une boucle à la fin de votre code sur cette collection vous devriez y arriver.

Je crois que je ai mal expliqué mon sous-niveau en VBA :ptdr:

Je vais faire quelques tests mais je sais déjà que j'y arriverai pas :oops:
07/08/2019, 17h21
Invité

Citation:

Envoyé par Anthony47

Avez-vous la possibilité de mettre en ligne un fichier word terminé (avec vos 20 objets) avec vos inlineshapes en indiquant le résultat à obtenir par rapport à ces objets ?
07/08/2019, 17h29
Anthony47

La tu trouveras le fichier Excel, en lançant la macro Export excel to word depuis le bouton création Word, ça va créer le fichier Word.

Et là tu verras que les dimensions des objets exporté sont trop larges :(

https://www.cjoint.com/c/IHhpANCiA1P

Citation:

Envoyé par Anthony47

Votre code modifié ci-dessous cadre l'image horizontalement, mais vous n'obtiendrez pas grand chose car la hauteur de l'image dépasse la hauteur de la page Word.

Code:

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
 
Sub ExcelWord()
 
Dim Obj As Object
Dim NewObj As Object
Dim myRange, MyFile
Dim MonInlineShape As Object
 
 
    Set Obj = CreateObject("Word.Application")
    Obj.Visible = True
    Set NewObj = Obj.Documents.Add
 
    ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
 
    Obj.Selection.PasteSpecial Link:=True, DataType:=wdPasteBitmap, Placement:=wdInLine, DisplayAsIcon:=False
 
    Set MonInlineShape = NewObj.inlineshapes(1)
    With MonInlineShape
         .Width = 460.8
    End With
 
    'Obj.Selection.InsertBreak Type:=wdPageBreak
 
 
    MyFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    NewObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & MyFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    Obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
 
    Set MonInlineShape = Nothing
    Set Obj = Nothing
    Set NewObj = Nothing
 
End Sub

Le code ci-dessous colle la sélection Excel sous différents formats et transforme l'image en shape.

Code:

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
 
Sub ExcelWord_V2()
 
Dim WordApp As Object, AppDoc As Object, MaForme As Object
Dim MyFile As String
Dim NbInLineShape As Integer
 
 
    With ActiveWorkbook
         MyFile = .Path & "\" & Replace(.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
         .Worksheets("En_tête").Range("page_01").Copy
    End With
 
 
    Set WordApp = CreateObject("Word.Application")
    With WordApp
        .Visible = True
        Set AppDoc = .Documents.Add
    End With
 
    With AppDoc
         .PageSetup.TopMargin = WordApp.CentimetersToPoints(1)
         .PageSetup.BottomMargin = WordApp.CentimetersToPoints(1)
    End With
 
    'WordApp.Selection.PasteSpecial Link:=True, DataType:=wdPasteBitmap, Placement:=wdInLine, DisplayAsIcon:=False
    ' WordApp.Selection.PasteSpecial Link:=True, DataType:=4, Placement:=0, DisplayAsIcon:=False
    ' WordApp.Selection.PasteSpecial Link:=True, DataType:=10, Placement:=0, DisplayAsIcon:=False ' Format HTML
     WordApp.Selection.PasteSpecial Link:=True, DataType:=2, Placement:=0, DisplayAsIcon:=False ' Format Text
 
     With AppDoc
         NbInLineShape = .inlineshapes.Count
         If NbInLineShape > 0 Then
            Set MaForme = .inlineshapes(NbInLineShape).ConvertToShape
            With MaForme
                 Debug.Print .Top
                 .Width = 460.8
                 .Left = 69.5
            End With
            Set MaForme = Nothing
         End If
    End With
 
 
 
     '   AppDoc.SaveAs2 Filename:=MyFile, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
     '   AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
     '   EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
 
        AppDoc.SaveAs2 Filename:=MyFile, FileFormat:=12, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False ', CompatibilityMode:=14
 
    WordApp.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
 
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    Set WordApp = Nothing
    Set AppDoc = Nothing
 
End Sub

Le résultat le plus approchant est en format text mais ne sera jamais parfait.

Nb : En instanciant une session Word en late binding comme vous le faîte, les paramètres Wd... ne fonctionnent pas, il vous faut utiliser leurs équivalents numériques.

Je pense qu'il vous faut appliquer la méthode utilisée dans l'autre discussion. C'est à dire transférer votre tableau partie par partie à l'aide de signets. Pour cela, il faut vous aider d'un fichier modèle où vous aurez déjà positionné vos signets.

08/08/2019, 08h14
Anthony47

Merci Eric,
Je sais pas si ça change grang chose, mais je crois que vous êtes parti de la mauvaise macro !

La bonne macro que j'utilise est celle juste après "export_excel_to_word". :mrgreen:

J'ai inséré vos lignes de codes dans ma macro :

Code:

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
75
76
77
78
79
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function
 
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
    Dim MonInlineShape As Object 'Nouveau
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 ' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
 ' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
 
For n = 1 To 3
    If exist("En_tête", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("En_tête").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
 Set MonInlineShape = newObj.inlineshapes(1) 'nouveau
    With MonInlineShape
         .Width = 460.8
    End With
 
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9
    End If
Next
 
For n = 1 To 15
    If exist("Descriptif", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Descriptif").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
For n = 1 To 5
    If exist("Carac_tech", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Carac_tech").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
    Set MonInlineShape = Nothing
 
End Sub

La largeur du premier collage est bien effective, mais il semble que la proportionnalité n'est pas gardée, du coup tout est déformé et le collage reste plus grand en longueur que la page. :(

08/08/2019, 08h34
Invité

Citation:

Envoyé par Anthony47

Non, le principe est le même.

Sinon, ce que je comprends de votre outil, c'est de constituer un document Word à partir de différents onglets. Pour l'instant vous essayez d'envoyer le contenu de l'onglet En_tête mais sans doute que Descriptif et Carac_tech vont suite, est-bien cela ?
J'imagine que le but final sera de constituer un fichier pdf pour envoi au client, est-ce bien cela ?
08/08/2019, 08h44
Anthony47

Oui c'est ça, sur l'autre macro c'est plus claire, on voit que l'onglet En_tête peut faire de 1 à 3 page word, l'onglet descriptif de 1 à 15 page et le dernier 1 à 3.

Le contenu des pages est géré par l'utilisateur en ajustant les saut de page sur Excel, puis en lançant la macro qui génère des plages nommées équivalente.

Ensuite dans la macro export_excel_to_word je reprend ces plages une à une et je les colle.

Le but est de l'avoir sur Word pour en rajouter certaines chose, du texte, des schémas et plus tard des entêtes et pieds de page. Puis de l'enregistrer sous PDF.
08/08/2019, 09h20
Invité

Citation:

Envoyé par Anthony47

OK. Si vous avez lu totalement ma réponse d'hier soir, il vous faut travailler partie par partie.

Si vous êtes stagiaire dans votre entreprise et que votre mission s'arrête à la fin de la création de cet outil, il faut que d'autres que vous sache prendre le relais pour en garantir la pérennité. C''est déjà compliqué pour du VBA Excel de trouver des ressources en interne, en VBA Word, ce n'est même pas la peine d'y compter. Personnellement, je ne procéderais pas de cette manière.

Imaginez que chacun de vos onglets à éditer soient imprimés directement en pdf dans un répertoire destiné aux devis, et qu'à l'issue de toutes les éditions, tous les pdf soient assemblés pour ne faire qu'un seul document. C'est ce que fait PdfCreator. Quant aux différents schémas qui viennent s'ajouter, ce sont des onglets particuliers et qui doivent être en annexe du document principal. J'aurais donc un onglet menu où j'aurais la liste des onglets éditables dans une colonne et leur nom pdf dans une autre colonne de manière qu'on retrouve leur ordre d'assemblage (doc1, doc2, etc...) dans le répertoire de destination. C'est simple, évolutif et ne nécessite aucune compétence informatique.

Pour pdfcreator, il vous faut charger la dll PDFCREATOR_COM. http://docs.pdfforge.org/pdfcreator/...com-interface/. Je pense qu'il faut une licence.

Regardez également chez Ron De BRUIN https://docs.microsoft.com/en-us/pre...1(v=office.11).

Sinon, le spécialiste de ce sujet sur le Forum Excel, c'est Kiki29, mais j'ai l'impression que bon nombre de ses contributions ont disparu.
08/08/2019, 09h27
Anthony47

Alors non je ne suis pas stagiaire ^^'

Pour Word c'est vraiment une nécessité, les utilisateurs auront beaucoup de choses à renseigner en plus des exports qui sont bien plus pratique à gérer sur Word que sur Excel. :)

Mais la on touche au but ! il suffit "juste" de garder la proportionnalité et d'appliquer les changements à tous les objets exportés ! :mrgreen:
08/08/2019, 09h35
Invité

Citation:

Envoyé par Anthony47

Citation:

Alors non je ne suis pas stagiaire ^^'

Ce projet aura alors la chance de durer.

Citation:

Mais la on touche au but ! il suffit "juste" de garder la proportionnalité et d'appliquer les changements à tous les objets exportés ! :mrgreen:

Regardez alors l'idée d'un fichier modèle Word dans lequel vous aurez prédéfini l'emplacement de vos différentes captures par des signets. Il y a des exemples récents sur le forum Word et regardez le tuto d'Olivier LEBEAU.
08/08/2019, 09h44
Anthony47

Citation:

Envoyé par Eric KERGRESSE

Regardez alors l'idée d'un fichier modèle Word dans lequel vous aurez prédéfini l'emplacement de vos différentes captures par des signets.

Le fait que mon nombre d'objet soit variable n'est pas un problème ?
08/08/2019, 09h51
Invité

Citation:

Envoyé par Anthony47

Le fait que mon nombre d'objet soit variable n'est pas un problème ?

Il suffit de créer plus de signets que d'éléments variables quitte à supprimer les inutiles ensuite s'ils contiennent du texte.
08/08/2019, 10h54
Anthony47

J'ai trouvé ce tuto https://heureuxoli.developpez.com/of...vba-word/#LVII

Mais franchement je suis perdu.. je pense avoir à peu prés compris ce qu'est un signet mais je sais pas comment l'utiliser ni quel est le rapport avec le dimensionnement de mes exports, ni comment faire un fichier modèle..

Comme je vous l'ai dit, je ne suis pas capable de créer du code de toute pièce.. :oops: :(