Discussion :

[zellinho]

Bonjour mesdames, messieurs les experts

J'ai besoin de vos lumières car là... je bloque...

Voici mon programme vba Excel :

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
 
 
Option Explicit
Dim debut_tableau As Integer, fin_tableau As Integer
Dim DocWord As Word.Document
Dim AppWord As Word.Application
 
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
 
Sub Test()
 
Set AppWord = CreateObject("word.application") 'ouvre session word
Set DocWord = AppWord.Documents.Open("xxx\test.docx", ReadOnly:=True) 'ouvre document Word
 
    AppWord.Visible = True 'affiche le document Word
 
    CopieTableauxEtGraphDansWord S_InfosEntite, "infos_AIS", "CH", "CW", 1, 23, 425.25  'soit 15 cm
    CopieTableauxEtGraphDansWord S_InfosEntite, "graphs1_AIS", "CH", "CW", 25, 36, 368.55  'soit 13 cm
    CopieTableauxEtGraphDansWord S_InfosEntite, "graphs2_AIS", "CH", "CW", 51, 62, 368.55  'soit 13 cm
    CopieTableauxEtGraphDansWord S_InfosEntite, "graphs3_AIS", "CH", "CW", 38, 49, 368.55  'soit 13 cm
    CopieTableauxEtGraphDansWord S_InfosEntite, "graphs4_AIS", "CH", "CW", 64, 75, 368.55  'soit 13 cm
 
End Sub
 
 
 
 
Sub CopieTableauxEtGraphDansWord(Onglet As Worksheet, NomSignet As String, _
                                    ColDebut As String, ColFin As String, _
                                    LigneDebut As Integer, LigneFin As Integer, _
                                    DimensionCible As Variant)
Application.CutCopyMode = True
 
    Onglet.Activate
    Range(ColDebut & LigneDebut & ":" & ColFin & LigneFin).Copy
 
    With AppWord
        .Selection.HomeKey Unit:=wdStory   'envoie en début de page
        'recherche du signet
        .Selection.Goto What:=wdGoToBookmark, Name:=NomSignet
    End With 'les signets du document Word sont nommés Signet1 , Signet2 , Signet3
 
    AppWord.Selection.PasteSpecial link:=False, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
    AppWord.Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
 
    Dim largeur_pixel_origine As Integer, largeur_pixel_objectif As Variant
    largeur_pixel_origine = AppWord.Selection.InlineShapes(1).Width
 
    Dim hauteur_pixel_origine As Integer, hauteur_pixel_objectif As Variant
    hauteur_pixel_origine = AppWord.Selection.InlineShapes(1).Height
 
    largeur_pixel_objectif = DimensionCible 'ça fait 13 cm sur le doc word
 
    Dim coeff_reducteur As Variant
    coeff_reducteur = largeur_pixel_objectif / largeur_pixel_origine
    hauteur_pixel_objectif = hauteur_pixel_origine * coeff_reducteur
 
    With AppWord.Selection.InlineShapes(1)
       .LockAspectRatio = msoTrue
       .Width = largeur_pixel_objectif
       .Height = hauteur_pixel_objectif
    End With
 
Application.CutCopyMode = False
End Sub
 
Sub VidePressePapier()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub
 
Sub CalculTailleTableauPourCopie(Onglet As Variant, sujet As Variant)
Dim i As Integer, TailleMax As Integer, Id As String
debut_tableau = 0
fin_tableau = 0
 
 
TailleMax = Onglet.Cells(1, 20).Value
 
i = 1
Do While i <= TailleMax
    If ActiveSheet.Cells(i, 19) = sujet Then
        If ActiveSheet.Cells(i, 18) = "debut_tableau" Then
            debut_tableau = i
        End If
 
        Id = Left(ActiveSheet.Cells(i, 3).Value, 14)
        If ActiveSheet.Cells(i, 18) = "debut_tableau" And Id = "Pas de données" Then
            fin_tableau = i
            Exit Do
        End If
 
        If ActiveSheet.Cells(i, 18) = "fin_tableau" Then
            fin_tableau = i
            Exit Do
        End If
    End If
i = i + 1
Loop
 
End Sub

J'ai plusieurs tableaux excel & graphiques dans l'onglet "S_InfosEntite". J'ai un doc word test.docx où j'ai inséré plusieurs signet pour que les tableaux et graphiques se positionnent à l'endroit défini...

Quand je lance ma macro test... elle fonctionne jusqu'à la ligne
largeur_pixel_origine = AppWord.Selection.InlineShapes(1).Width
au sein de l'itération :
CopieTableauxEtGraphDansWord S_InfosEntite, "graphs3_AIS", "CH", "CW", 38, 49, 368.55 'soit 13 cm

Il me met comme erreur :
Erreur d'exécution 5941:
Le membre de la collection requis n'existe pas.




Mes questions :
1- pouvez-vous m'aider ? si oui, quelles sont les solutions ?
2- J'ai essayé d'utiliser ma procédure VidePressePapier mais cela ne fonctionne pas ... du coup, j'ai mis les lignes Application.CutCopyMode = True / Application.CutCopyMode = False, mais je ne suis pas sûr que cela soit au bon endroit... et cela ne vide pas pour autant mon presse-papier.

Pour info, j'ai un certain nombre (important > 100) de tableaux-graphiques à copier-coller dans mon doc Word que j'enregistre ensuite en format PDF.

Merci par avance.

[zellinho]

Une autre remarque :
Dans mon pgm ci-dessus, à chaque fois, je demande à ouvrir le doc word... j'aimerais pouvoir l'utiliser même s'il est déjà ouvert.... comment puis-je faire ?

Merci

[zellinho]

On peut fermer cette discussion (enfin ce monologue ^^) ?

J'ai fait une copie de ce sujet dans le bon forum, à savoir celui des macros vba excel.

Thx