Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel copier coller feuille afec graph sans liaison par macro

copier coller feuille afec graph sans liaison par macro

1 réponse
Avatar
sleg
Bonjour,

j'ai un probleme avec cette macro sur la derniere partie FE4, c'est
une feuille avec des graphiques (25) et la macro me les copie avec la
liaison avec les donn=E9es qui ne seront pas consultable donc j'aimerais
savoir s'il est possible de faire une copier coller juste image a la
place de ce que j'ai a l'heure actuelle.

merci de votre aide.


MAcro :
Sub Export01()
Dim Cl As Workbook
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Fe3 As Worksheet
Dim Fe4 As Worksheet
Set Fe1 =3D Worksheets("Chronos")
Set Fe2 =3D Worksheets("Fiche a valider")
Set Fe3 =3D Worksheets("Fiche a envoyer")
Set Fe4 =3D Worksheets("Graph Mois")

Application.ScreenUpdating =3D False
Set Cl =3D Workbooks.Add
With Cl
Application.DisplayAlerts =3D False
.SaveAs ("\\serveur\repertoire01\R=E9f=E9rentiels" & "\" &
"Indispo_2010_V2r01" & ".xls")

Fe1.Copy .Worksheets("Feuil1")
ActiveSheet.Name =3D "Chronos"
Sheets("Chronos").Select
Cells.Select
Application.CutCopyMode =3D False
Selection.Copy
Selection.PasteSpecial Paste:=3DxlPasteValues, Operation:=3DxlNone,
SkipBlanks _
:=3DFalse, Transpose:=3DFalse


Fe2.Copy .Worksheets("Feuil2")
ActiveSheet.Name =3D "Fiche a valider"
Sheets("Fiche a valider").Select
Cells.Select
Application.CutCopyMode =3D False
Selection.Copy
Selection.PasteSpecial Paste:=3DxlPasteValues, Operation:=3DxlNone,
SkipBlanks _
:=3DFalse, Transpose:=3DFalse

Fe3.Copy .Worksheets("Feuil3")
ActiveSheet.Name =3D "Fiche a envoyer"
Sheets("Fiche a envoyer").Select
Cells.Select
Application.CutCopyMode =3D False
Selection.Copy
Selection.PasteSpecial Paste:=3DxlPasteValues, Operation:=3DxlNone,
SkipBlanks _
:=3DFalse, Transpose:=3DFalse

Fe4.Copy .Worksheets("Feuil3")
ActiveSheet.Name =3D "Graph Mois"
Sheets("Graph Mois").Select
Cells.Select
Application.CutCopyMode =3D False
Selection.Copy
Selection.PasteSpecial Paste:=3DxlPasteValues, Operation:=3DxlNone,
SkipBlanks _
:=3DFalse, Transpose:=3DFalse

Application.DisplayAlerts =3D False
.Worksheets("Feuil1").Delete
.Worksheets("Feuil2").Delete
.Worksheets("Feuil3").Delete
.Worksheets("Feuil4").Delete
Application.DisplayAlerts =3D True
.Save
.Close
End With
Application.ScreenUpdating =3D True
Set Fe1 =3D Nothing
Set Fe2 =3D Nothing
Set Fe3 =3D Nothing
Set Cl =3D Nothing
End Sub
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
isabelle
bonjour sleg,

voici un exemple

'_______________________________________________________________________________
'Comment exporter plusieurs graphiques dans une même image gif
'auteur: SilkyRoad
'Cet exemple regroupe les 4 premiers graphiques incorporés de la feuille
active puis les exporte en un seule image gif.
'_______________________________________________________________________________
Private Const Fichier As String = "C:ImageTemp.gif"

Sub ExporteGIF_GroupeGraphiques()
Dim Sh As Shape
Dim Tableau(1 To 4) As String
'Sous Excel2000, indiquez:
'Dim Tableau(1 To 4) As Variant
Dim i As Integer, Nb As Integer

'Supprime l'image temporaire si elle existe
If Dir(Fichier) <> "" Then Kill Fichier

'Boucle sur les 4 premiers graphiques de la feuille active
For i = 1 To 4
Tableau(i) = ActiveSheet.ChartObjects(i).Name
Next

'Regroupe les graphiques
Set Sh = ActiveSheet.Shapes.Range(Tableau).Group

'copie la forme
Sh.CopyPicture
'crée un graphique
With ActiveSheet.ChartObjects.Add(0, 0, _
Sh.Width, Sh.Height).Chart
.Paste 'colle l'image dans graphique
' enregistre le graphique au format gif
.Export Fichier, "GIF"
End With

Nb = ActiveSheet.ChartObjects.Count
'supprime le graphique
ActiveSheet.ChartObjects(Nb).Delete

Sh.Ungroup
End Sub
'_______________________________________________________________________________

isabelle

sleg a écrit :
Bonjour,

j'ai un probleme avec cette macro sur la derniere partie FE4, c'est
une feuille avec des graphiques (25) et la macro me les copie avec la
liaison avec les données qui ne seront pas consultable donc j'aimerais
savoir s'il est possible de faire une copier coller juste image a la
place de ce que j'ai a l'heure actuelle.

merci de votre aide.


MAcro :
Sub Export01()
Dim Cl As Workbook
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Fe3 As Worksheet
Dim Fe4 As Worksheet
Set Fe1 = Worksheets("Chronos")
Set Fe2 = Worksheets("Fiche a valider")
Set Fe3 = Worksheets("Fiche a envoyer")
Set Fe4 = Worksheets("Graph Mois")

Application.ScreenUpdating = False
Set Cl = Workbooks.Add
With Cl
Application.DisplayAlerts = False
.SaveAs ("serveurrepertoire01Référentiels" & "" &
"Indispo_2010_V2r01" & ".xls")

Fe1.Copy .Worksheets("Feuil1")
ActiveSheet.Name = "Chronos"
Sheets("Chronos").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse


Fe2.Copy .Worksheets("Feuil2")
ActiveSheet.Name = "Fiche a valider"
Sheets("Fiche a valider").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

Fe3.Copy .Worksheets("Feuil3")
ActiveSheet.Name = "Fiche a envoyer"
Sheets("Fiche a envoyer").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

Fe4.Copy .Worksheets("Feuil3")
ActiveSheet.Name = "Graph Mois"
Sheets("Graph Mois").Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:úlse

Application.DisplayAlerts = False
.Worksheets("Feuil1").Delete
.Worksheets("Feuil2").Delete
.Worksheets("Feuil3").Delete
.Worksheets("Feuil4").Delete
Application.DisplayAlerts = True
.Save
.Close
End With
Application.ScreenUpdating = True
Set Fe1 = Nothing
Set Fe2 = Nothing
Set Fe3 = Nothing
Set Cl = Nothing
End Sub