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
Private Sub CommandButton1_Click()
      Dim WdApp As Word.Application
      Dim WdDoc As Word.Document
      Dim i, hauteur As Double, plage As Range
      Dim j As Integer
      Dim k As Integer
      Dim nbre As Integer
 
      Set WdApp = CreateObject("word.application")
      Set WdDoc = WdApp.Documents.Open("C:\ah.doc")
 
      WdApp.Visible = True
 
 
      nbre = ActiveWorkbook.Sheets.Count
 
 
 
 
 
 
 
 
 
 For j = 2 To 11
             If Worksheets(j).Range(J25) <> 0 Or Worksheets(j).Range(J26) <> 0 Then
 
 
 
        Do                          'Sélection de la plage de cellules à copier
            On Error Resume Next                          'gère une plage nulle
            Set plage = Range("A1:L38")
           If plage Is Nothing Then GoTo Fin             'sortie si plage vide
             On Error GoTo 0
             Loop While InStr(plage.Address, ",") <> 0
             plage.Copy                                                'plage copiée
             DoEvents                  'laisse au system le temps de copier la plage
 
                                      'Place l'image sur le signet "Signet"
            With WdApp
                .Selection.Goto What:=wdGoToBookmark, Name:="Signet"
                .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _
                Placement:=wdInLine, DisplayAsIcon:=False
                WdDoc.InlineShapes(1).Width = 132    'Règle la largeur dans Word
 
                       'Calcul de la hauteur de plage dans le document word
                 hauteur = 132 / WdDoc.InlineShapes(1).Width _
                             * WdDoc.InlineShapes(1).Height
                 WdDoc.InlineShapes(1).Height = Int(hauteur)       'Règle la hauteur
            End With
 
      End If
Next j
 
 
 
 
 
 
 
 If nbre > 15 Then
    For k = 16 To nbre
      If Worksheets(k).Range(J25) <> 0 Or Worksheets(k).Range(J26) <> 0 Then
 
 
 
    Do                          'Sélection de la plage de cellules à copier
        On Error Resume Next                          'gère une plage nulle
        Set plage = Range("A1:L38")
        If plage Is Nothing Then GoTo Fin             'sortie si plage vide
        On Error GoTo 0
    Loop While InStr(plage.Address, ",") <> 0
    plage.Copy                                                'plage copiée
    DoEvents                  'laisse au system le temps de copier la plage
 
                                      'Place l'image sur le signet "Signet"
    With WdApp
           .Selection.Goto What:=wdGoToBookmark, Name:="Signet"
           .Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _
                       Placement:=wdInLine, DisplayAsIcon:=False
           WdDoc.InlineShapes(1).Width = 132    'Règle la largeur dans Word
 
                          'Calcul de la hauteur de plage dans le document word
           hauteur = 132 / WdDoc.InlineShapes(1).Width _
                                * WdDoc.InlineShapes(1).Height
           WdDoc.InlineShapes(1).Height = Int(hauteur)       'Règle la hauteur
       End With
       End If
      Next k
 
 End If
    'WdApp.Visible = True 'Pour voir (Ne pas fermer le fichier depuis Word)
 
Fin::
    WdDoc.Close True                       'Enregistre et ferme le doc word
    DoEvents            'Laisse au system le temps d'enregistrer le fichier
    WdApp.Quit                                            'ferme la session
 
    Set plage = Nothing
    Set WdApp = Nothing
    Set WdDoc = Nothing
End Sub
Voila mon programme ce met en erreur d'application, j'ai fais la pas a pas.J'ai remarquer que c'était
Dim WdApp As Word.Application
Dim WdDoc As Word.Document