Pastespecial - résultat change en fonction de la sortie vidéo
Bonjour,
Je m'arrache les cheveux sur ce problème :
J'ai un onglet qui me sert d'export, j'y copie/colle (VBA) les images des graphes issus de différentes années => c'est un récap
Mon fichier est dynamique c'est a dire que le nombre d'années n'est pas fixé donc a chaque génération de mon export je supprime tout et re- copie/colle mes images.
Le problème :
- Quand j'exécute la macro et que le fenêtre est sur mon écran d'ordi portable => il n'y a pas de problèmes
- Quand j'exécute la macro et que le fenêtre est sur un écran secondaire (HDMI(PC) - convertisseur - VGA(écran)) => des lignes viennent s'ajouter (1 ligne s'ajoute a la première page, n lignes s'ajoutent a la nème page) - cf photos ci dessous (photos prise sur la prévisualisation avant impression - le résultat est le même sur la zone d'impression de l'onglet correspondant)
cas : Fenêtre sur mon ordi portable :
...
cas : fenêtre sur mon deuxième écran :
...
- il n'y a que 4 années pour l'instant donc avec les espaces ca reste encore sur une page, mais dans 5 ans (donc 5 onglets de + donc 5 lignes de plus sur la dernière page) ce n'est pas dit, en plus de ca le rendu ne fais pas très propres avec toutes les pages qui sont différentes.
Voici le code expliqué :
Sub printExport()
Worksheets("Pour export").Select ' ou sheets.activate ou worksheet.activate
Worksheets("Pour export").Activate
Dim shp As Shape
'init sheet not dynamic part
'deleting
Sheets("Pour export").Cells.Clear
For Each shp In Sheets("Pour export").Shapes
shp.Delete
Next shp
'resetting text
With Sheets("Pour export").Range("A1:F1")
.MergeCells = True
.Value = "Export des graphiques"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Color = RGB(255, 0, 0)
.Font.Italic = True
.Font.Bold = True
End With=> j'ai trouvé qu'en activant spécifiquement la page de l'export avant de le faire, le problème n'apparaissait plus quand le fenêtre est sur mon ordi portable
Activation de la fenêtre & suppression de l'ancien export qui a été créé.
Dim ws As Worksheet
Dim wb As Workbook
Dim name As String
Dim rng1, rng2, rng3, rng4, r1, r2, r3, r4 As Range
Dim cntshape As Integer
Dim cntyear As Integer
cntyear = 0
cntshape = 1
'speed up excel
Call LudicrousMode(True)
'graphiques comparatif
Set r1 = Sheets("Pour export").Range("A2:F10")
Set r2 = Sheets("Pour export").Range("A11:F20")
Set r3 = Sheets("Pour export").Range("A21:F30")
Set r4 = Sheets("Pour export").Range("A31:F40")
Sheets("Graphique comparatif par année").ChartObjects("Graphique 3").Copy
Sheets("Pour export").Range("A1").PasteSpecial
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = r1.Left
.Top = r1.Top
.Width = r1.Width
.Height = r1.Height
End With
cntshape = cntshape + 1 'count++
Sheets("Graphique comparatif par année").ChartObjects("Graphique 4").Copy
Sheets("Pour export").Range("A1").PasteSpecial
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = r2.Left
.Top = r2.Top
.Width = r2.Width
.Height = r2.Height
End With
cntshape = cntshape + 1 'count++
Sheets("Graphique comparatif par année").ChartObjects("Graphique 2").Copy
Sheets("Pour export").Range("A1").PasteSpecial
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = r3.Left
.Top = r3.Top
.Width = r3.Width
.Height = r3.Height
End With
cntshape = cntshape + 1 'count++
Sheets("Graphique comparatif par année").ChartObjects("Graphique 1").Copy
Sheets("Pour export").Range("A1").PasteSpecial
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = r4.Left
.Top = r4.Top
.Width = r4.Width
.Height = r4.Height
End With
cntshape = cntshape + 1 'count++=> déclarations et création d'un premier jeu de graphique tout en haut de la page, avec lesquels il n'y a pas de problèmes.
For Each ws In ThisWorkbook.Sheets
name = Replace(ws.name, "Grahique_", "")
If ws.name Like "Graphiques_????" Then
'titre de l'année & mise en forme
With Sheets("Pour export").Range("A" & 51 + (50 * cntyear) & ":F" & 51 + (50 * cntyear))
.MergeCells = True
.Value = name
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ThemeColor = xlThemeColorLight2
.Interior.TintAndShade = 0.599993896298105
End With
'definition du range pour chaque graphe : a faire dynamiquement
Set rng1 = Sheets("Pour export").Range("A2:C13").Offset(50 + (50 * cntyear), 0)
Set rng2 = Sheets("Pour export").Range("D2:F13").Offset(50 + (50 * cntyear), 0)
Set rng3 = Sheets("Pour export").Range("A14:F27").Offset(50 + (50 * cntyear), 0)
Set rng4 = Sheets("Pour export").Range("A28:F45").Offset(50 + (50 * cntyear), 0)
'copie / colle des images de graphe
Sheets(ws.name).ChartObjects("Graphique 1").Copy
Sheets("Pour export").Range("A1").PasteSpecial
'faire fct en envoyer range + shape ?
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = rng1.Left
.Top = rng1.Top
.Width = rng1.Width
.Height = rng1.Height
End With
'passe a la shape dapres
cntshape = cntshape + 1
'///////////////////////////////////// a mettre dans fct
'copie / colle des images de graphe
Sheets(ws.name).ChartObjects("Graphique 3").Copy
Sheets("Pour export").Range("A1").PasteSpecial
'faire fct en envoyer range + shape ?
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = rng2.Left
.Top = rng2.Top
.Width = rng2.Width
.Height = rng2.Height
End With
'passe a la shape dapres
cntshape = cntshape + 1
'copie / colle des images de graphe
Sheets(ws.name).ChartObjects("Graphique 2").Copy
Sheets("Pour export").Range("A1").PasteSpecial
'faire fct en envoyer range + shape ?
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = rng3.Left
.Top = rng3.Top
.Width = rng3.Width
.Height = rng3.Height
End With
'passe a la shape dapres
cntshape = cntshape + 1
'copie / colle des images de graphe
Sheets(ws.name).ChartObjects("Graphique 4").Copy
Sheets("Pour export").Range("A1").PasteSpecial
'faire fct en envoyer range + shape ?
With Sheets("Pour export").Shapes(cntshape)
.LockAspectRatio = msoFalse
.Left = rng4.Left
.Top = rng4.Top
.Width = rng4.Width
.Height = rng4.Height
End With
'passe a la shape dapres
cntshape = cntshape + 1
'///////////////////////////////////// a mettre dans fct
cntyear = cntyear + 1
End If
Next=> création des autres jeu de graphiques (par années) : mise en forme de la ligne du haut de chaque page, définition dynamique des range pour l'utilisation des attributs .left .top .right .left pour le formatage de chaque photos. cntyear compte le nombre d'années qui ont déjà été saisie pour les offset => ceux qui servent a passer a la plage d'après et la définition des ranges. cntshape compte le nombre de shapes pour formater et copier les bonnes shapes
Application.CutCopyMode = False
Call LudicrousMode(False)
'impression : modif la plage avec offset
ActiveWorkbook.Sheets("Pour export").Range("A1:F" & cntyear * 50 + 50).PrintPreview
End Sub=> création de la plage a imprimer, j'ai trouvé que c'était plus rapide de faire comme ca que de créer une zone d'impression
l'onglet "Graphique comparatif par années" possède 4 graphes
Voici a quoi ressemble l'onglet d'une année :
Je ne peux malheureusement pas joindre le fichier. j'espère ma description claire et les information fournies suffisantes.
Je n'ai pas trop d'idées pour la résolution de ce problème.. j'ai essayé sur d'autres ordinateurs ayant un autre écran, le problème est récurrent. peut être peut t'on forcer l'application sur une sortie vidéo en particulier ?
- je viens de m'apercevoir que l'indentation a un peu été refaire comme j'ai séparé le code pour fournir quelques explications, je remettrais le code dans une réponse dédiée au besoin.
Merci d'avance,
Giglobastre