IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Signet à leur place, mais pas des graphs qui ne retrouvent pas leur signets


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    Profil pro
    Inscrit en
    avril 2013
    Messages
    86
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : avril 2013
    Messages : 86
    Points : 41
    Points
    41
    Par défaut
    Alors voilà ma macro d'import de graph sous forme d'image dans word marche très bien.
    J'ai associé des signets pour mettre les graphs à leur place dans mon document.
    Appelé du style: DRSS, DSS, D1, NE, NI...

    Le problème c'est que quand je compile, mes graphs se placent une fois sur 3 de la bonne manière, et évidemment plus j'augmente le nombre de graphs dans mon doc, plus c'est rare que tout soit bien mis. Je peux avoir des doublons alors qu'il yen a aucun normalement, pourtant quand je regarde l'adresse du signet, elle est bonne, mais le graph n'est pas le bon.

    Je vois pas comment un programme logique puisse faire du aléatoire comme ça.
    Je rappel que je procède toujours de la même manière pour compiler. j'ai beau fermer excel/word et réouvrir, j'ai toujours ces beugs.

    code:

    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
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    Sub Export_Graphiques_Vers_Word()
    ' Cette macro permet de transférer de copier les graphiques contenus
    ' vers un document Word (gabarit)
    ' Les 2 fichiers doivent se trouver dans le même répertoire.
    ' Il faut au préalable définir des signets dans le gabarit Word afin d'insérer le texte
    '
    ' Grand Chaman Excel 2013-03-15
        Sheets("graph").Select
        Dim wrdApp As Word.Application
        Dim wrdDoc As Word.Document
        Dim ws As Worksheet
        Dim i As Integer
     
        Application.ScreenUpdating = False
     
        Set ws = ThisWorkbook.Sheets(1)    'Onglet contenant les graphiques
     
        ' - On suppose que le fichier Word est déjà ouvert
        Set wrdApp = GetObject(, "Word.Application")        'Word déjà ouvert
        Set wrdDoc = wrdApp.ActiveDocument
     
    Sheets("graph").Select
        Range("O45").Select
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("Expotot").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="Expotot"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("PropI").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropI"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("PropO").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropO"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("PropR").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropR"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("PropIEBF").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="PropIEBF"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("NC").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NC"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("NI").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NI"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("NE").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="NE"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        ' -- Copier le 1er Graphique nommé "fig1"
        ActiveSheet.ChartObjects("Nambiant").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="Nambiant"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
        Sheets("diag").Select
        Range("O45").Select
     
       If [G5>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("DSS").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="DSS"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
    End If
        If [G23>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("DRDC").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="DRDC"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     End If
        If [G41>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D1").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D1"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
    End If
        If [G59>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D2").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D2"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
    End If
     
        If [G77>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D3").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D3"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G95>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D4").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D4"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G113>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D5").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D5"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G131>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D6").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D6"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G149>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D7").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D7"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G167>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D8").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D8"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     If [G185>0] Then ' => SI condition validée ALORS
       ActiveSheet.ChartObjects("D9").Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        wrdApp.Selection.Goto What:=wdGoToBookmark, Name:="D9"   ' on recherche le signet dans Word pour se positionner
        'wrdApp.Selection.MoveLeft wdCharacter, 1                        ' optionnel : pour se placer AVANT le signet (move left)
        wrdApp.Selection.Paste
     
    End If
     
     
     
     
     
        Set wrdDoc = Nothing: Set wrdApp = Nothing
        Application.ScreenUpdating = True
     
     
     
    Sheets("Cas A").Select
    End Sub
    Personne n'a déjà vu ou eut ce problème?

  2. #2
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 200
    Points : 14 338
    Points
    14 338
    Par défaut
    Bonjour,

    J'ai testé ton code (les 3 premiers graphiques) et je n'ai pas constaté d'anomalie. Quelle est ta version d'Excel ?
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  3. #3
    Membre du Club
    Profil pro
    Inscrit en
    avril 2013
    Messages
    86
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : avril 2013
    Messages : 86
    Points : 41
    Points
    41
    Par défaut
    Alors quand je remet tout a jour (fermer et réouvrir tout, on va dire que ca marche deux fois sur 3). Avec 3 graphs jamais eut de soucis, c'est quand ca dépasse les 10/15 dans un même doc.
    Excell et word 2007.

    Apparement il fallait que je redémarre le PC, a priori je n'ai plus trop de soucis là... Je vais quand même bien chercher pourquoi, mais bon..

  4. #4
    Expert éminent sénior
    Homme Profil pro
    aucune
    Inscrit en
    septembre 2011
    Messages
    8 200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : septembre 2011
    Messages : 8 200
    Points : 14 338
    Points
    14 338
    Par défaut
    Peut-être un problème de mémoire ? Mets une instruction :
    entre chaque collage.
    Cordialement.

    Daniel

    La plus perdue de toutes les journées est celle où l'on n'a pas ri. Chamfort

  5. #5
    Membre du Club
    Profil pro
    Inscrit en
    avril 2013
    Messages
    86
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : avril 2013
    Messages : 86
    Points : 41
    Points
    41
    Par défaut
    Ca à l'air bon merci.
    cdt

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 1
    Dernier message: 18/05/2011, 17h08
  2. Interdire des navigateur qui ne sont pas a jour ?
    Par allpicI2c dans le forum Général Conception Web
    Réponses: 5
    Dernier message: 28/01/2006, 19h30
  3. UNION ? des lignes qui ne sont pas prises...
    Par fred23195 dans le forum Langage SQL
    Réponses: 3
    Dernier message: 01/12/2005, 15h50
  4. [XSL][re] Ecrire des balise qui ne seront pas interpretées
    Par FrRoulio dans le forum XSL/XSLT/XPATH
    Réponses: 8
    Dernier message: 17/03/2004, 13h32
  5. la liste des clients qui n'ont pas acheter aucun article ...
    Par TéBeSsI dans le forum Langage SQL
    Réponses: 6
    Dernier message: 13/02/2004, 15h57

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo