Discussion :

[Telluca]

Bonjour le forum,

J'utilise un fichier excel qui est constitué de quelques 30 onglets classés pour la plupart par ordre alphabétique . Seuls certains sont actifs lors de l'utilisation.
Il comporte un onglet titré SYNTHESE qui regroupe les données des onglets actifs. Grace à un bouton je copie colle le tableau synthese ds un signet word.
jusqu'ici rien de bien exceptionnel.
Là où je butte , c'est que je voudrais compléter le code ci dessous en déclenchant un copier coller si et seulement si un onglet est actif, mettons l'onglet A par exemple.

les onglets contiennent tous le même tableau de A1 à H56.

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
Sub ComandButton1_Click()
Dim DocWord As Word.Document
Dim AppWord As Word.Application
 
    Set AppWord = New Word.Application
    Application.DisplayAlerts = True
    AppWord.ShowMe
    AppWord.Visible = True
    'Ouvre le document Word
    Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\RAPPORT_REV0.docm")
    ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A1:H26").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("fixe").Range.Paste
     DocWord.Tables(1).AutoFitBehavior (wdAutoFitWindow)
 
      Application.CutCopyMode = False
 
  ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A27:H30").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("individuel").Range.Paste
    DocWord.Tables(2).AutoFitBehavior wdAutoFitWindow
    Application.CutCopyMode = False
 
 
EN FAIT A PARTIR D'ICI JE VOUDRAIS CREER UNE CONDITION AU COPIER COLLER MAIS JE NE TROUVE PAS LA BONNE SYNTAXE If Then End IF
 
  ' Copie les données Excel
    ThisWorkbook.Worksheets("FIXE A").Range("A1:H56").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("annexefixea").Range.Paste
    DocWord.Tables(3).AutoFitBehavior wdAutoFitWindow
    Application.CutCopyMode = False
 
 
  Set DocWord = Nothing
    Set AppWord = Nothing
 
End Sub

J'espère être suffisamment précis

Au plaisir de lire vos réponse .

[Invité]

Bonjour,

Une solution consisterait à établir une table d'association Nom de l'onglet - Signet et en fonction de l'onglet actif de récupérer le nom du signet.

Pour cela, j'ai créé un onglet paramètres contenant deux colonnes. La liste des onglets est une zone nommée ListeDesOnglets.

Pièce jointe 297378


Pour récupérer le nom du signet j'ai créé cette fonction dans un module standard

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
 
' Dans un module standard
 
Function NomDuSignet(ByVal AireOngletsSignets As Range, ByVal NomDeLonglet As String) As String
 
Dim CelluleOngletsSignets As Range
 
    NomDuSignet = ""
    For Each CelluleOngletsSignets In AireOngletsSignets
 
        If CelluleOngletsSignets = NomDeLonglet Then
            NomDuSignet = CelluleOngletsSignets.Offset(0, 1)
            Exit Function
        End If
    Next CelluleOngletsSignets
 
End Function

J'ai ensuite modifié votre code pour prendre en compte l'aire de l'onglet actif.

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
 
 
Sub ComandButton1_Click()
 
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim MonOnglet As Worksheet
 
' A ajouter
Dim MaListeDOnglets As Range
Dim MonSignet As String
 
    Set MonOnglet = ActiveSheet
    Set MaListeDOnglets = Sheets("Paramètres").Range("ListeDesOnglets")
 
    Set AppWord = New Word.Application
    Application.DisplayAlerts = True
    AppWord.ShowMe
    AppWord.Visible = True
    'Ouvre le document Word
    Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\RAPPORT_REV0.docm")
    ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A1:H26").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("fixe").Range.Paste
    DocWord.Tables(1).AutoFitBehavior (wdAutoFitWindow)
 
    Application.CutCopyMode = False
 
    ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A27:H30").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("individuel").Range.Paste
    DocWord.Tables(2).AutoFitBehavior wdAutoFitWindow
    Application.CutCopyMode = False
 
      ' Copie les données Excel
    If MonSignet = NomDuSignet(MaListeDOnglets, MonOnglet.Name) <> "" Then
        MonOnglet.Range("A1:H56").Copy
        ' Colle les données dans Word
        DocWord.ActiveWindow.Document.Bookmarks(MonSignet).Range.Paste
        DocWord.Tables(3).AutoFitBehavior wdAutoFitWindow
        Application.CutCopyMode = False
    End If
 
 
    Set DocWord = Nothing
    Set AppWord = Nothing
    Set MaListeDOnglets = Nothing
    Set MonOnglet = Nothing
 
End Sub

A tester et à adapter.

[Telluca]

Bonjour,

merci de votre réponse qui m'a presque fait voir la solution pour toucher le résultat attendu.

Néanmoins le code s'arrête au moment de copier coller le tableau de l'onglet choisi et je ne vois vraiment pas ce qui bloque

je joins à ce message les fichiers en question . ce sera sûrement plus parlant.

bonne journée

[Invité]

Bonjour,

Il vaudrait mieux insérer le code de la procédure en entier en indiquant l'endroit où ça bloque. Si cela ne suffit pas, il sera toujours possible d'aller voir dans vos fichiers.

[Telluca]

Ah très bien .
Au temps pour moi
comme dit précédemment ca bloque au moment du copy de la plage de l'onglet (en bleu ici)

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
' Dans un module standard
 
Function NomDuSignet(ByVal AireOngletsSignets As Range, ByVal NomDeLonglet As String) As String
 
Dim CelluleOngletsSignets As Range
 
    NomDuSignet = ""
    For Each CelluleOngletsSignets In AireOngletsSignets
 
        If CelluleOngletsSignets = NomDeLonglet Then
            NomDuSignet = CelluleOngletsSignets.Offset(0, 1)
            Exit Function
        End If
    Next CelluleOngletsSignets
 
End Function

Sub ComandButton1_Click()
 
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim MonOnglet As Worksheet
 
' A ajouter
Dim MaListeDOnglets As Range
Dim MonSignet As Variant
 
    Set MonOnglet = ActiveSheet
    Set MaListeDOnglets = Sheets("PARAMETRES").Range("ListeDesOnglets")
 
    Set AppWord = New Word.Application
    Application.DisplayAlerts = True
    AppWord.ShowMe
    AppWord.Visible = True
    'Ouvre le document Word
    Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\RAPPORT_REV0.docm")
    ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A1:H26").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("fixe").Range.Paste
    DocWord.Tables(1).AutoFitBehavior (wdAutoFitWindow)
 
    Application.CutCopyMode = False
 
    ' Copie les données Excel
    ThisWorkbook.Worksheets("SYNTHESE").Range("A27:H30").Copy
    ' Colle les données dans Word
    DocWord.ActiveWindow.Document.Bookmarks("individuel").Range.Paste
    DocWord.Tables(2).AutoFitBehavior wdAutoFitWindow
    Application.CutCopyMode = False
 
      ' Copie les données Excel
    If MonSignet = NomDuSignet(MaListeDOnglets, MonOnglet.Name) <> "" Then
        MonOnglet.Range("A1:H56").Copy
        ' Colle les données dans Word
        DocWord.ActiveWindow.Document.Bookmarks(MonSignet).Range.Paste
        DocWord.Tables(3).AutoFitBehavior wdAutoFitWindow
        Application.CutCopyMode = False
    End If
 
 
    Set DocWord = Nothing
    Set AppWord = Nothing
    Set MaListeDOnglets = Nothing
    Set MonOnglet = Nothing
 
End Sub

le reste fonctionne parfaitement .

Cordialement

[Invité]

Mettez votre code entre balises Code (icône #) comme ceci

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
 
Function NomDuSignet(ByVal AireOngletsSignets As Range, ByVal NomDeLonglet As String) As String
 
Dim CelluleOngletsSignets As Range
 
NomDuSignet = ""
For Each CelluleOngletsSignets In AireOngletsSignets
 
If CelluleOngletsSignets = NomDeLonglet Then
NomDuSignet = CelluleOngletsSignets.Offset(0, 1)
Exit Function
End If
Next CelluleOngletsSignets
 
End Function
 
Sub ComandButton1_Click()
 
Dim DocWord As Word.Document
Dim AppWord As Word.Application
Dim MonOnglet As Worksheet
 
' A ajouter
Dim MaListeDOnglets As Range
Dim MonSignet As Variant
 
Set MonOnglet = ActiveSheet
Set MaListeDOnglets = Sheets("PARAMETRES").Range("ListeDesOnglets")
 
Set AppWord = New Word.Application
Application.DisplayAlerts = True
AppWord.ShowMe
AppWord.Visible = True
'Ouvre le document Word
Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\RAPPORT_REV0.docm")
' Copie les données Excel
ThisWorkbook.Worksheets("SYNTHESE").Range("A1:H26").Copy
' Colle les données dans Word
DocWord.ActiveWindow.Document.Bookmarks("fixe").Range.Paste
DocWord.Tables(1).AutoFitBehavior (wdAutoFitWindow)
 
Application.CutCopyMode = False
 
' Copie les données Excel
ThisWorkbook.Worksheets("SYNTHESE").Range("A27:H30").Copy
' Colle les données dans Word
DocWord.ActiveWindow.Document.Bookmarks("individuel").Range.Paste
DocWord.Tables(2).AutoFitBehavior wdAutoFitWindow
Application.CutCopyMode = False
 
' Copie les données Excel
If MonSignet = NomDuSignet(MaListeDOnglets, MonOnglet.Name) <> "" Then
MonOnglet.Range("A1:H56").Copy
' Colle les données dans Word
DocWord.ActiveWindow.Document.Bookmarks(MonSignet).Range.Paste
DocWord.Tables(3).AutoFitBehavior wdAutoFitWindow
Application.CutCopyMode = False
End If
 
 
Set DocWord = Nothing
Set AppWord = Nothing
Set MaListeDOnglets = Nothing
Set MonOnglet = Nothing
 
End Sub

Il n'est pas trop tard pour le faire.

Sinon, je regarde.

[Invité]

La macro ComandButton1_Click ne peut être dans un module standard. La remplacer par celle-ci :

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
 
 
Sub EditerDansWord()
 
Dim DocWord As Object
Dim AppWord As Object
Dim MonOnglet As Worksheet
Dim OngletSynthese As Worksheet
 
Dim MaListeDOnglets As Range
Dim MonSignet As String
 
    Set OngletSynthese = Sheets("SYNTHESE")
    Set MonOnglet = ActiveSheet
    Set MaListeDOnglets = Sheets("Paramètres").Range("ListeDesOnglets")
 
    MonSignet = NomDuSignet(MaListeDOnglets, MonOnglet.Name)
    If MonSignet <> "" Then
 
       Set AppWord = CreateObject("word.application") 'ouvre session word et le fichier voulu
       AppWord.Visible = True
 
       Set DocWord = AppWord.Documents.Open(ThisWorkbook.Path & "\RAPPORT_REV0.docx")
 
       With DocWord
 
            OngletSynthese.Range("A1:H26").Copy
            .Bookmarks("fixe").Range.Paste
            .Tables(1).AutoFitBehavior (wdAutoFitWindow)
            Application.CutCopyMode = False
 
            OngletSynthese.Range("A27:H30").Copy
            .Bookmarks("individuel").Range.Paste
            .Tables(2).AutoFitBehavior wdAutoFitWindow
            Application.CutCopyMode = False
 
 
            MonOnglet.Range("A1:H56").Copy
            .Bookmarks(MonSignet).Range.Paste
            .Tables(3).AutoFitBehavior wdAutoFitWindow
            Application.CutCopyMode = False
 
            .Close SaveChanges:=True
 
        End With
 
    End If
 
    Set DocWord = Nothing
 
    AppWord.Quit
 
    Set AppWord = Nothing
    Set MaListeDOnglets = Nothing
    Set MonOnglet = Nothing
    Set OngletSynthese = Nothing
 
End Sub

Modifier la macro dans votre Userform1 : (Vérifier la syntaxe de la commande : 1 m ou 2m dans Command).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub CommandButton1_Click()
 
        EditerDansWord
        Unload UserForm1
 
End Sub

[Telluca]

Ca maaaaaaaaaaaarcheeeeeeeeeeeee!!!!!!!!!!!!!!!!!!

merci beaucoup pour votre aide