Discussion :

[billynirvana]

Je vous expose mon problème. Je suis en train de mettre en place une copie d'un sous ensemble de mes feuilles Excel d'un document A vers un autre document B. Je souhaite écrire une macro qui s'exécute rapidement.

Voici ma macro:

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
Dim sourceBook As Excel.Workbook
Dim newFile As Excel.Workbook
Dim newSheet As Worksheet
Dim astrLinks As Variant

Set sourceBook = Application.ActiveWorkbook
Set newFile = Workbooks.Add(xlWBATWorksheet)

Set newSheet = newFile.Worksheets("Feuil1")
newSheet.Name = "Scenario"
sourceBook.Sheets("Scenario").Unprotect
sourceBook.Sheets("Scenario").Range("all" & "Scenario").Copy newSheet.Range("A1")
astrLinks = newFile.LinkSources(Type:=xlLinkTypeExcelLinks)
newFile.BreakLink Name:=astrLinks(1), Type:=xlLinkTypeExcelLinks

newFile.SaveAs (sourceBook.Path & "\doc_version_light.xls")

Si j'enlève les deux lignes en roses, la macro s'exécute en 2 secondes, mais je perds mes graphes et mes images.
Si je laisse comme ça, mes graphes et images restent mais je peux prendre un café (voire 2 ou 3) entre temps....

Merci de votre collaboration


Billy

[billynirvana]

J'ai résolu mon problème avec ceci, mais comment maintenant le coller aux bonnes coordonnées ?? Ce code copie tous mes graphiques au coin supérieur gauche

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
Dim sourceBook As Excel.Workbook
Dim newFile As Excel.Workbook
Dim newSheet As Worksheet
Dim astrLinks As Variant
 
Set sourceBook = Application.ActiveWorkbook
Set newFile = Workbooks.Add(xlWBATWorksheet)
 
Set newSheet = newFile.Worksheets("Feuil1")
newSheet.Name = "Scenario"
sourceBook.Sheets("Scenario").Unprotect
sourceBook.Sheets("Scenario").Range("all" & "Scenario").Copy newSheet.Range("A1")
 
For Each Graph In sourceBook.Sheets("Scenario").ChartObjects
    Graph.CopyPicture
    newSheet.PasteSpecial Link:=False, DisplayAsIcon:=False
 
Next Graph
 
newFile.SaveAs (sourceBook.Path & "\doc_version_light.xls")

[billynirvana]

Ce problème est résolu...

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
Dim sourceBook As Excel.Workbook
Dim newFile As Excel.Workbook
Dim newSheet As Worksheet
Dim astrLinks As Variant
 
Set sourceBook = Application.ActiveWorkbook
Set newFile = Workbooks.Add(xlWBATWorksheet)
 
Set newSheet = newFile.Worksheets("Feuil1")
newSheet.Name = "Scenario"
sourceBook.Sheets("Scenario").Unprotect
sourceBook.Sheets("Scenario").Range("all" & "Scenario").Copy newSheet.Range("A1")
 
For Each Graph In sourceBook.Sheets("Scenario").ChartObjects
    Graph.CopyPicture
    newSheet.PasteSpecial Link:=False, DisplayAsIcon:=False
    newSheet.DrawingObjects.left = Graph.left
    newSheet.DrawingObjects.top = Graph.top
Next Graph
 
newFile.SaveAs (sourceBook.Path & "\doc_version_light.xls")

Maintenant une dernière et je vous embête plus: Comment dimensionner les cases du document destination avec les mêmes hauteurs et largeur que le source??

[cafeine]

Hello,

j'ai posté un code qui semble pouvoir répondre à ta problématique :

http://www.developpez.net/forums/sho...d.php?t=258635