Moim zdaniem aby użyć kontrolki ChartSpace na UserForm, należy wykorzystac SpreedSheet (co już w innym poście pokazałam) bądź przepisac dane do tablicy.
Lecz patrząc na Twoje posty, naprawdę nie wiem jaką w końcu masz koncepcję.
Jeżeli chcesz dodać wykres do arkusza (WorkSheet) to można tak:
Nie należy się sugerwoać długością kodu, bo tu obsługa błedów jest konieczna raczej.Sub MojWykres(RangeDane As Range, _
ByVal NazwaWykresu As String, _
oRangeTopLeft As Range)
Dim oWsh As Worksheet
Dim oChrt As Chart
Set oWsh = oRangeTopLeft.Parent
On Error Resume Next
' sprawdzamy na wszelki wypadek czy jest na tymarkuszu już wyres o nazwie NazwaWykresu
oWsh.ChartObjects(NazwaWykresu).Name = NazwaWykresu
If Err <> 0 Then
' znaczy nie ma wykresu o tej nazwie
On Error GoTo MojWykre_Error
' dodajemy go do skoroszytu w ktorym jest ten nasz arkusz (Parent)
Set oChrt = oWsh.Parent.Charts.Add
With oChrt
.SetSourceData Source:=RangeDane, PlotBy:=xlColumns
.ChartType = xl3DPie
.Location Where:=xlLocationAsObject, Name:=oRangeTopLeft.Parent.Name
End With
' dodalismy go przed chwila, wiec jest ostatni Count !
' nadajemy mu nasza nazwe by potem go identyfikować + polozenie
With oWsh
With .ChartObjects(.ChartObjects.Count)
.Name = NazwaWykresu
.Left = oRangeTopLeft.Left
.Top = oRangeTopLeft.Top
End With
End With
Else
On Error GoTo MojWykre_Error
' znaczy jest wykresu o tej nazwie tylko zakers danych zmieniamy
oWsh.ChartObjects(NazwaWykresu).Chart.SetSourceData Source:=RangeDane, _
PlotBy:=xlColumns
End If
MojWykre_Exit:
On Error Resume Next
Set oChrt = Nothing
Set oWsh = Nothing
Exit Sub
MojWykre_Error:
MsgBox "Błąd - " & Err.Number & vbCrLf & _
"Opis - " & Err.Description & vbCrLf & _
"Procedura - " & "MojWykre", vbExclamation
Resume MojWykre_Exit
End Sub wywołujemy tak:Call MojWykres(RangeDane:=ThisWorkbook.Worksheets("2.2.1.").Range("D4 :E9"), _
NazwaWykresu:="moj_wykres", _
oRangeTopLeft:=ThisWorkbook.Worksheets("2.2.1.").Range("F10")) albo na przykład tak:
Sub Inaczej(RangeDane As Range, _
ByVal NazwaWykresu As String, _
oRangeTopLeft As Range)
Dim oWsh As Worksheet
Dim oChrt As ChartObject '!!!!!!!!!!!
Set oWsh = oRangeTopLeft.Parent
On Error Resume Next
' sprawdzamy na wszelki wypadek czy jest na tymarkuszu już wyres o nazwie NazwaWykresu
Set oChrt = oWsh.ChartObjects(NazwaWykresu)
If Err <> 0 Then
' znaczy nie ma wykresu o tej nazwie
On Error GoTo Inacz_Error
' dodajemy go arkusza
Set oChrt = oWsh.ChartObjects.Add(oRangeTopLeft.Left, _
oRangeTopLeft.Top, 300, 200)
With oChrt
.Chart.SetSourceData Source:=RangeDane, PlotBy:=xlColumns
.Chart.ChartType = xl3DPie
.Name = NazwaWykresu
End With
Else
On Error GoTo Inacz_Error
' jeśli wykres taki już istnieje wystarczy zmiana zakresu
With oChrt
.Chart.SetSourceData Source:=RangeDane, PlotBy:=xlColumns
.Chart.ChartType = xl3DPie
End With
End If
Inacz_Exit:
On Error Resume Next
Set oChrt = Nothing
Set oWsh = Nothing
Exit Sub
Inacz_Error:
MsgBox "Błąd - " & Err.Number & vbCrLf & _
"Opis - " & Err.Description & vbCrLf & _
"Procedura - " & "Inacz", vbExclamation
Resume Inacz_Exit
End Sub wywołujemy tak:Call Inaczej(RangeDane:=ThisWorkbook.Worksheets("2.2.1.").Range("D4 :E9"), _
NazwaWykresu:="moj_drugiwykres", _
oRangeTopLeft:=ThisWorkbook.Worksheets("2.2.1.").Range("F20"))
Jeżli chcesz skopiować obraz wykresu z arkusza to na przykład w module możesz napisać tak: Sub CopiujNaImageUserform(oImg As MSForms.Image, _
ByVal NazwaWykresu As String, _
Wsh As Worksheet)
On Error GoTo CopiuNaImageUserf_Error
Dim strSciezkaNazawPliku As String
strSciezkaNazawPliku = ThisWorkbook.Path & "\tmp.gif"
Call UsunPlik(strSciezkaNazawPliku)
On Error Resume Next
Dim oChrt As Chart
Set oChrt = Wsh.ChartObjects(NazwaWykresu).Chart
If Err = 0 Then
oChrt.Export Filename:=strSciezkaNazawPliku, FilterName:="GIF"
oImg.Picture = LoadPicture(strSciezkaNazawPliku)
Else
MsgBox "Brak wykresu o nazwie " & NazwaWykresu
End If
CopiuNaImageUserf_Exit:
On Error Resume Next
Exit Sub
CopiuNaImageUserf_Error:
MsgBox "Błąd - " & Err.Number & vbCrLf & _
"Opis - " & Err.Description & vbCrLf & _
"Procedura - " & "CopiuNaImageUserf", vbExclamation
Resume CopiuNaImageUserf_Exit
End Sub
Sub UsunPlik(ByVal sSciezkaPlik As String)
On Error Resume Next
Kill sSciezkaPlik
End Sub W kodzie klasy !!!! UserForm wywołujemy tak: Sub test()
Call CopiujNaImageUserform(Me.ImageMoj, _
NazwaWykresu:="moj_wykres", _
Wsh:=ThisWorkbook.Worksheets("2.2.1."))
Me.ImageMoj.AutoSize = True
End Sub gdzie Me.ImageMoj jest Twoją kotrolką Image.
A skoro Ty masz pusty Image to na bank masz wyłączoną obsługę błędów i nie widzisz gdzieś błedu oraz zapewne nie masz option Explict i nie kompilujsz kodu.
Bo to:Sub wykres()
Dim CurrentChart As Chart
Dim Fname As String
Set CurrentChart = Sheets("2.2.1.").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp.gif"
CurrentChart.Export Filename:=Fname, FilterName:="GIF"
frm_wykres.ImageMoj.Picture = LoadPicture(Fname)
frm_wykres.Show
End Sub
u mnie działa, aczkolwiek ...Kill itd........ i nie wiem co robi F5.... może załóż sobie BreakPoint i zobacz czy wchodzisz do porcedury... |
wstecz 1 dalej
otwarty rozpoczął: alicelee
postów: 20
