Ewigefrost
XLDnaute Junior
Bonjour à tous !
Bon je reviens pour un soucis sur mon projet d'enregistrement automatique de plages de cellules à chaque changement de cellules dans 2 des feuilles de mon classeur.
Voilà le code que j'utilise, il fait en sorte que dès qu'une cellule change dans TCD ALU ou TCD ACIER, une image d'un tableau+diagrammes (dans TCD ALU) à hauteur variable s'enregistre, et de même pour le tableau dans TCD ACIER. La date de l'enregistrement s'exporte aussi en image.
Les variables "dernieracier" et "Dligne" sont les variables qui me permettent de trouver la ligne de fin du tableau+diagrammes (dont le nombre de lignes est variable je rappelle).
Le macro fonctionne, elle ne plante pas, mais il y a deux problèmes :
-lorsque j'ajoute une ligne dans TCD ALU, l'image exportée de TCD ALU est bonne, alors que celle de TCD ACIER bug complètement (et vice-versa)
-de plus, sur les images qui s'exportent, il y a les diagrammes en fond mais avec une mise en forme totalement différente et inadaptée (déjà ils ne devraient pas apparaitre en plus des diagrammes "normaux", et ensuite ils se mettent en fond, c'est très bizarre). J'ai l'impression que des lignes dans la macro disent implicitement à Excel de recréer des diagrammes, mais ça ne me convient absolument pas !
J'espère que j'ai été assez clair, je suis preneur de toutes explications !
Merci beaucoup par avance !
PS : l'exportation marche très bien lorsque je spécifie un range fixe dans ces lignes :
Bon je reviens pour un soucis sur mon projet d'enregistrement automatique de plages de cellules à chaque changement de cellules dans 2 des feuilles de mon classeur.
Voilà le code que j'utilise, il fait en sorte que dès qu'une cellule change dans TCD ALU ou TCD ACIER, une image d'un tableau+diagrammes (dans TCD ALU) à hauteur variable s'enregistre, et de même pour le tableau dans TCD ACIER. La date de l'enregistrement s'exporte aussi en image.
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
Sheets("Date").[B2] = Now
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NLigneDescription As Long
Dim Dligne As Long
wshSheets = [{"TCD ACIER", "TCD ALU"}]
If Not IsError(Application.Match(Sh.Name, wshSheets, 1)) Then
With Worksheets("TCD ALU").Range("A1:N50")
Cells.Find(What:="Total général", After:=Range("A1"), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
NLigneDescription = ActiveCell.Row
'Range("A200").Value = NLigneDescription
Dligne = NLigneDescription + 14
'Range("A201").Value = Dligne
'Worksheets("TCD ALU").Range("N" & NLigneDescription & ":" & "W" & NLigneDescription).Interior.Color = RGB(222, 0, 0)
End With
With Worksheets("TCD ACIER").Range("P1:P40")
Cells.Find(What:="Total général", After:=Range("P1"), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
acier = ActiveCell.Row
'Range("A200").Value = NLigneDescription
dernieracier = acier + 7
'Range("A201").Value = Dligne
'Worksheets("TCD ALU").Range("N" & NLigneDescription & ":" & "W" & NLigneDescription).Interior.Color = RGB(222, 0, 0)
End With
With Sheets("date")
.Range("B2").CopyPicture xlScreen, xlPicture
With .ChartObjects.Add(0, 0, .Range("B2").Width, .Range("B2").Height).Chart
.Paste
.Export ThisWorkbook.Path & "\date.png", "PNG"
End With
.ChartObjects(Sheets("date").ChartObjects.Count).Delete
End With
With Sheets("TCD ACIER")
Worksheets("TCD ACIER").Activate
ActiveWindow.Zoom = 100
.Range("P2:AA" & dernieracier).CopyPicture xlScreen, xlBitmap
With .ChartObjects.Add(0, 0, 2400, 1429).Chart
.Paste
.Export ThisWorkbook.Path & "\test2.gif", "gif"
End With
'.ChartObjects(Sheets("TCD ACIER").ChartObjects.Count).Delete
End With
With Sheets("TCD ALU")
Worksheets("TCD ALU").Activate
ActiveWindow.Zoom = 120
.Range("N2:X" & Dligne).CopyPicture xlScreen, xlBitmap
With .ChartObjects.Add(0, 0, 2400, 1429).Chart
.Paste
.Export ThisWorkbook.Path & "\test1.gif", "gif"
End With
'.ChartObjects(Sheets("TCD ALU").ChartObjects.Count).Delete
End With
ActiveWorkbook.Save
End If
End Sub
Les variables "dernieracier" et "Dligne" sont les variables qui me permettent de trouver la ligne de fin du tableau+diagrammes (dont le nombre de lignes est variable je rappelle).
Le macro fonctionne, elle ne plante pas, mais il y a deux problèmes :
-lorsque j'ajoute une ligne dans TCD ALU, l'image exportée de TCD ALU est bonne, alors que celle de TCD ACIER bug complètement (et vice-versa)
-de plus, sur les images qui s'exportent, il y a les diagrammes en fond mais avec une mise en forme totalement différente et inadaptée (déjà ils ne devraient pas apparaitre en plus des diagrammes "normaux", et ensuite ils se mettent en fond, c'est très bizarre). J'ai l'impression que des lignes dans la macro disent implicitement à Excel de recréer des diagrammes, mais ça ne me convient absolument pas !
J'espère que j'ai été assez clair, je suis preneur de toutes explications !
Merci beaucoup par avance !
PS : l'exportation marche très bien lorsque je spécifie un range fixe dans ces lignes :
Code:
With Sheets("TCD ALU")
Worksheets("TCD ALU").Activate
ActiveWindow.Zoom = 120
.Range("N2:X" & Dligne).CopyPicture xlScreen, xlBitmap
With .ChartObjects.Add(0, 0, 2400, 1429).Chart
.Paste
.Export ThisWorkbook.Path & "\test1.gif", "gif"
End With
'.ChartObjects(Sheets("TCD ALU").ChartObjects.Count).Delete
End With
Dernière édition: