Change un graph excel en image

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 842 fois - Téléchargée 36 fois

Contenu du snippet

C'est mon premier prog, alors soyez indulgents!

En fait, on m'a demandé d'automatiser les commandes qui changent un graph excel en image ( coupe - collage spécial ... ).
Les gens qui se servent de ce prog ont des classeurs excel comportant bcp de feuilles comportant elle mêmes bcp de gaph... Afin d'envoyer le classeur sans que les destinataires ne peuvent toucher aux graph, ils les copiaient en image ce qui leur prenait bcp de temps!

Source / Exemple :


Sub CopieColle()

Dim NbDiapo As Integer
Dim EtaitVisible As Boolean

NbDiapo = Application.Sheets.Count
For j = 1 To NbDiapo
   NomDiapo = Application.Sheets(j).Name
   EtaitVisible = Sheets(NomDiapo).Visible
   Sheets(NomDiapo).Visible = True
   If Sheets(NomDiapo).Visible Then
      Sheets(NomDiapo).Select
      ActiveSheet.Cells.Select
      Selection.Copy
      Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Call Graph
      Sheets(NomDiapo).Visible = EtaitVisible
   End If
Next

End Sub

__________________________________________________________________________ 
Sub Maproc(NomGraphique As String, NomCell As String)

   ActiveSheet.ChartObjects(NomGraphique).Activate
   ActiveChart.ChartArea.Select
   Application.CutCopyMode = False
   ActiveWindow.Visible = False
   ActiveWindow.WindowState = xlNormal
   ActiveWindow.WindowState = xlMaximized
   Selection.cut
   Range(NomCell).Select
   ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", link:=False, displayAsIcon:=False

End Sub

__________________________________________________________________________

Sub Graph()

Dim NomCell As String
i = 1

NbGraph = ActiveSheet.ChartObjects.Count
NbTotal = NbGraph + 1
If NbGraph = 0 Then Exit Sub
While i < NbTotal
   NomCell = ActiveSheet.ChartObjects(1).TopLeftCell.Address
   Call Maproc(ActiveSheet.ChartObjects(1).name, NomCell)
   i = i + 1
Wend

End Sub

Conclusion :


Grand merci à Ica94 qui m'a permis de debuguer mon programme !!!!

Maintenant il prend en compte les pages cachées ( le but est qu'il n'y ait plus de lien avec un autre classeur donc les pages masquées sont prises en compte et visibles ).

A voir également

Ajouter un commentaire

Commentaires

cs_lca94
Messages postés
46
Date d'inscription
mercredi 29 janvier 2003
Statut
Membre
Dernière intervention
28 janvier 2006
-
plutot bien ce prog :) j'ai fait presque pareil pour un client ..mais en plus il fallait mettre tout ça sur un donc Word ... en tableaux ... avec récup de données avant ! :)

pour enlever ton bug:
(exemple juste changer le sub CopieColle)

Sub CopieColle()

Dim NbDiapo As Integer
Dim était_visible As Boolean 'tu gardes en mémoire l'état visible ou non
'en solution2, tu peux aussi carément éviter toutes les feuilles invisibles si c'est ce qu'attendais l'utilisateur
'dans ce cas tu enlèves la ligne >>> plus bas
'et de plus la variable était_visible n'est plus utile (tu peux aussi faire le 2 avec un paramètre)

NbDiapo = Application.Sheets.Count
For j = 1 To NbDiapo
NomDiapo = Application.Sheets(j).Name
était_visible = Sheets(NomDiapo).Visible
'en rendans ta page visible, tu peux sélectionner une shape
Sheets(NomDiapo).Visible = True '>>> c la ligne a enlever si on doit sauter les pages invisibles
If Sheets(NomDiapo).Visible Then
'>>>solution 2:si c'est pas visible je le fais pas,
Sheets(NomDiapo).Select
ActiveSheet.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Call Graph
Sheets(NomDiapo).Visible = était_visible
End If
Next

End Sub
cs_lca94
Messages postés
46
Date d'inscription
mercredi 29 janvier 2003
Statut
Membre
Dernière intervention
28 janvier 2006
-
ha pareil pour les graphiques cachés : utilise le .visible pour l'éviter ou le rendre copiable

... mais je ne sais pas cacher un graphique hors VB ... marrant comment ils ont fait?
cs_Ninette13
Messages postés
15
Date d'inscription
mercredi 16 juillet 2003
Statut
Membre
Dernière intervention
30 juillet 2003
-
Ca je ne sais pas!!!
Enfin merci pour le tuyau!!!
:o)
Bye bye!
cs_Ninette13
Messages postés
15
Date d'inscription
mercredi 16 juillet 2003
Statut
Membre
Dernière intervention
30 juillet 2003
-
Ca y est j'ai modifié mon source sous les conseils très judicieux de lca94 que je remercie!
A priori il n'y a plus de bug ( l'espoir fait vivre, non ? ) mais si il y en a que ça intéresse et qu'ils ont trouvé un ou plusieurs bugs, je serai ravie qu'ils m'aident à le débuguer !!!!!!

Merci à tous!

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.