AW: Diagramm exportieren
24.12.2022 00:10:29
Beverly
Hi Miguel,
bei mir wird das Diagramm komplett angezeigt - ich benutze einen breiten Bildschirm. Allerdings muss ich dazu sagen, dass ich Excel2016 verwende.
Ich habe deinen Code mal ein wenig vereinfacht und auch die Variablen so dimensioniert wie man sie dimensionieren sollte:
Sub Test()
Dim lngLastRow As Long
Dim dblXValuesMaximum As Double
Dim dblXValuesMinimum As Double
Dim dblYValuesMaximum As Double
Dim dblYValuesMinimum As Double
UserForm001.Height = Application.Height
UserForm001.Width = Application.Width
UserForm001.Frame001.Width = UserForm001.OptionButton001.Width + 12
UserForm001.Image001.Height = UserForm001.Height - 76
UserForm001.Image001.Width = UserForm001.Width - UserForm001.Image001.Left - UserForm001.Frame001.Width - 28
UserForm001.Frame001.Left = UserForm001.Image001.Left + UserForm001.Image001.Width + 12
UserForm001.Frame001.Top = UserForm001.Image001.Top - 5
UserForm001.CommandButton001.Left = (UserForm001.Width - 136) / 2
UserForm001.CommandButton001.Top = UserForm001.Height - 52
lngLastRow = Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
dblXValuesMaximum = Application.WorksheetFunction.Max(Range(Cells(1, 2), Cells(lngLastRow, 2)))
dblXValuesMaximum = Application.WorksheetFunction.RoundUp(dblXValuesMaximum, 1)
dblXValuesMinimum = Application.WorksheetFunction.Min(Range(Cells(1, 2), Cells(lngLastRow, 2)))
dblXValuesMinimum = Application.WorksheetFunction.RoundDown(dblXValuesMinimum, 1)
dblYValuesMaximum = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(lngLastRow, 1)))
dblYValuesMaximum = Application.WorksheetFunction.RoundUp(dblYValuesMaximum, 1)
dblYValuesMinimum = Application.WorksheetFunction.Min(Range(Cells(1, 1), Cells(lngLastRow, 1)))
dblYValuesMinimum = Application.WorksheetFunction.RoundDown(dblYValuesMinimum, 1)
With ActiveSheet.ChartObjects.Add(10, 10, UserForm001.Image001.Width, UserForm001.Image001.Height)
.Name = "Diagram"
With .Chart
.ChartType = xlXYScatterLinesNoMarkers
.ChartArea.Border.LineStyle = xlNone
With .SeriesCollection.NewSeries
.Border.ColorIndex = 1
.Border.Weight = xlMedium
.XValues = Range(Cells(1, 2), Cells(lngLastRow, 2))
.Values = Range(Cells(1, 1), Cells(lngLastRow, 1))
End With
.Axes(xlCategory).MinimumScale = dblXValuesMinimum
.Axes(xlCategory).MaximumScale = dblXValuesMaximum
.Axes(xlCategory).Border.ColorIndex = 16
.Axes(xlCategory).TickLabels.Font.ColorIndex = 16
.Axes(xlValue).MinimumScale = dblYValuesMinimum
.Axes(xlValue).MaximumScale = dblYValuesMaximum
.Axes(xlValue).Border.ColorIndex = 16
.Axes(xlValue).TickLabels.Font.ColorIndex = 16
.Axes(xlValue).MajorGridlines.Delete
.PlotArea.Border.LineStyle = xlNone
.PlotArea.Interior.ColorIndex = xlNone
.Legend.Delete
End With
End With
ActiveSheet.ChartObjects(1).Chart.Export Filename:=ThisWorkbook.Path & "\Diagram.jpg", FilterName:="JPG"
UserForm001.Image001.Picture = LoadPicture(ThisWorkbook.Path & "\Diagram.jpg")
Kill ThisWorkbook.Path & "\Diagram.jpg"
ActiveSheet.ChartObjects("Diagram").Delete
UserForm001.Left = Application.Left + Application.Width / 2 - UserForm001.Width / 2
UserForm001.Top = Application.Top + Application.Height / 2 - UserForm001.Height / 2
UserForm001.Show
End Sub
Bis später
Karin