Sujet Précédent Sujet Suivant

Récupérer tout le fichier excel et non le classeur ouvert

Fermé
Enshuk - 14 févr. 2020 à 10:24
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 15 févr. 2020 à 11:17
Bonjour,

Je travaille sur une macro, dont l'objectif est de récupérer dans un fichier Word tous les graphiques commençant par le même nom et ayant la même couleur d'onglet.
Si les graphiques sont sur le même onglet, ça fonctionne. Mais si ils sont sur un onglet différents, ils ne se copient pas sur le document Word.

J'ai essayé 
ActiveBook
au lieu de 
ActiveSheets
, mais sans succès...

Voici ma boucle : 


For Each Chart In ws.ChartObjects
   
    'a = Left(Chart.Name, 1)
    'MsgBox a

    If Left(Chart.Name, 1) = "(" And ws.Tab.Color = RGB(128, 128, 128) Then  
    
    
   
    
    
ActiveBooks.ChartObjects("(Test)").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="Graphique2" ' on recherche le signet dans Word pour se positionner
wrdApp.Selection.MoveRight wdCharacter, 1
'wrdApp.Selection.MoveLeft wdCharacter, 1 ' optionnel : pour se placer AVANT le signet (move left)
wrdApp.Selection.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False


Merci d'avance.


Configuration: Windows / Chrome 78.0.3904.97
A voir également:

4 réponses

Réponse 1 / 4
yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
14 févr. 2020 à 10:57
bonjour,
classeur et fichier étant synonymes, ton titre est un peu bizarre.
tu ne nous montres qu'une partie de ton code.
je suppose que ws est déclaré comme worksheet, et que tu fais une boucle pour faire le tour de tous les onglets de ton classeur.
je me demande si tu ne t'embrouilles pas en ayant choisi d'utiliser "Chart" comme nom de variable: utilises plutôt "graphique". Sois certain, aussi, d'avoir bien 
option explicit
en haut de ton module.
Je pense que tout s'éclaircira et que tu découvriras ton erreur.
1
Réponse 2 / 4
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
14 févr. 2020 à 11:06
Bonjour,

comme le dit yg_be si justement, ton titre est équivoque. Il s'agit d'onglet et non de classeur!

Dans ton dernier post je t'ai indiqué ce lien. Il ne fait pas le job?

Essaie de mettre un MsgBox pour voir si il boucle sur tous les graphiques. Si oui, c'est ta macro qui ne fait pas le job!

https://vb.developpez.com/faqvba/?page=3.5#listgraphique

0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
15 févr. 2020 à 11:17
Cela devrait t’intéresser en l'adaptant à ton environnement:

https://forum.excel-pratique.com/viewtopic.php?t=68158

@+ Le Pivert
0
Réponse 3 / 4
Enshuk
14 févr. 2020 à 11:24
Bonjour et merci pour vos réponses,

Si, cela m'a aidé. Je vous remercie encore infiniment.
Mais je n'ai réussi à l'appliquer qu'à l'onglet actif, et non au classeur tout entier.. C'est pour cette raison que j'ai posté ce sujet.
Veuillez m'excuser, si je n'ai pas été assez explicite.

Voilà le reste du code. 



Sub Export_Graphiques_Vers_Word()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim ws As Worksheet
Dim sh As Worksheet, i As Long
Dim AnyString, a


Application.ScreenUpdating = False
    
Set ws = ThisWorkbook.Sheets(1) 'Onglet contenant les graphiques


Set wrdApp = GetObject(, "Word.Application")
Set wrdDoc = wrdApp.ActiveDocument


For Each Chart In ws.ChartObjects
   

    If Left(Chart.Name, 1) = "(" And ws.Tab.Color = RGB(128, 128, 128) Then  'ws.Tab.Color = RGB(40, 150, 160) Then '("Sheet1") = RGB(40, 150, 160) Then
    
    
   
    
ActiveBooks.ChartObjects("(µ) Fv_SL_MECH").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="Graphique2" ' on recherche le signet dans Word pour se positionner
wrdApp.Selection.MoveRight wdCharacter, 1
'wrdApp.Selection.MoveLeft wdCharacter, 1 ' optionnel : pour se placer AVANT le signet (move left)
wrdApp.Selection.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False


End If
Next Chart
' -- Terminer
wrdDoc.Save
Set wrdDoc = Nothing: Set wrdApap = Nothing
Application.ScreenUpdating = True




'Else: MsgBox "Erreur"



End Sub
0
yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
Modifié le 14 févr. 2020 à 11:41 
Option Explicit

Sub Export_Graphiques_Vers_Word()

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim onglet As Worksheet
Dim graphique As Chart

Application.ScreenUpdating = False
Set wrdApp = GetObject(, "Word.Application")
Set wrdDoc = wrdApp.ActiveDocument
For Each onglet In ThisWorkbook.Sheets
    If onglet.Tab.Color = RGB(128, 128, 128) Then
        For Each graphique In onglet.ChartObjects
            If Left(graphique.Name, 1) = "(" Then   'ws.Tab.Color = RGB(40, 150, 160) Then '("Sheet1") = RGB(40, 150, 160) Then
                graphique.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
                wrdApp.Selection.Goto what:=wdGoToBookmark, Name:="Graphique2" ' on recherche le signet dans Word pour se positionner
                wrdApp.Selection.MoveRight wdCharacter, 1
                'wrdApp.Selection.MoveLeft wdCharacter, 1 ' optionnel : pour se placer AVANT le signet (move left)
                wrdApp.Selection.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
            End If
        Next graphique
    End If
Next onglet
' -- Terminer
wrdDoc.Save
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.ScreenUpdating = True
End Sub
0
Réponse 4 / 4
Enshuk
14 févr. 2020 à 11:45
Merci pour ton aide, je vais essayer de l'adapter.
Mais ça me retourne une erreur, incompatibilité de type pour 
Next onglet
0

Discussions similaires

comment donner les droits sur fichier partage
ch'ti du 57 -
fil1958 -

2 réponses
Chemin Logo du site de la Cité de l'espace
Keiios -
blux -

11 réponses