Vis grafter i userform

Opret en userform med en image-control på

Sæt denne kode ind i userformens modul
Denne linie i koden ændrer du til ark og navn på dit diagram
Set CurrentChart = Sheets("Data").ChartObjects(1).Chart


Private Sub UserForm_Initialize()
    UpdateChart
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Kill ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
End Sub

Private Sub UpdateChart()
    Dim CurrentChart As Chart
    Dim Fname As String
   
    Set CurrentChart = Sheets("Data").ChartObjects(1).Chart
 
'  Save chart as GIF
    Fname = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
    CurrentChart.Export FileName:=Fname, FilterName:="GIF"

'  Show the chart
    Image1.Picture = LoadPicture(Fname)
End Sub


Baggrundsbilledet på din userform indsætter du under userformens properties
Hvis du står i vba-editoren på userformen og ikke kan se disse så tryk F4
I properties finder du Picture og her kan du indsætte / browse efter dit billede.

Hvordan opretter jeg en image-control?
Hvis mit ark hedder ark1 og min mappe hedder NY, skal der så stå
Set CurrentChart = Sheets("ark1").ChartObjects(NY).Chart ???
Resten er forstået :-)

Og hvor skal jeg angive det område i ark1 jeg vil have vist?

Dit gantt-diagram --- er det ikke en graf ?

Nej, det er et område i excel range("A1:P15")

ok, blev forvirret af din overskrift.. :-)
Så kan du ikke bruge ovenstående, men opgaven er ikke umulig, tager bare lidt længere tid

ok, har du et forslag til hvordan det løses ;-) det vil være ret godt hvis det lykkedes.

Jeg ved jo, at det eneste Excel ikke kan, er at lave kaffe og hente pizza ;-)

Enig, den er ikke god til det med at lave kaffe, men den kan komme med kopholderen

Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
    ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
    ByVal hwndCallback As Long)


Sub OpenCDTray()
    mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub


Sub CloseCDTray()
    mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub



Spøg tilside. Her kommer det alvorlige
hvis din userform hedder UserForm1 og dit Image på denne hedder Image1 burde denne kunne gøre hvad du efterlyser. Sæt det hele i et alm. modul og kør Sub ShowUserForm

Option Explicit

Dim container As Chart
Dim ContainerBook As Workbook
Dim Obnavn As String
Dim SourceBook As Workbook
'Indsæt dit eget område
Const stRangetoCopi As String = "A1:P15"

Public Sub ShowUserForm()
  Call GIF_Snapshot
  UserForm1.Image1.Picture = LoadPicture( _
      Application.DefaultFilePath & "\img.gif")
  UserForm1.Show
End Sub

Private Sub ImageContainer_init()
  Workbooks.Add 1
  ActiveSheet.Name = "GIFcontainer"
  Charts.Add
  ActiveChart.ChartType = xlColumnClustered
  ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
  ActiveChart.Location Where:=xlLocationAsObject, _
      Name:="GIFcontainer"
  ActiveChart.ChartArea.ClearContents
  Set ContainerBook = ActiveWorkbook
  Set container = ActiveChart
End Sub

Private Sub MakeAndSizeChart(ih As Integer, iv As Integer)
  Dim Hincrease As Single
  Dim Vincrease As Single
  Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
  Hincrease = ih / ActiveChart.ChartArea.Height
  ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
      msoFalse, msoScaleFromTopLeft
  Vincrease = iv / ActiveChart.ChartArea.Width
  ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
      msoFalse, msoScaleFromTopLeft
End Sub

Private Sub GIF_Snapshot()
  Dim SaveName As Variant
  Dim Hi As Integer
  Dim Wi As Integer
  Set SourceBook = ActiveWorkbook
  Call ImageContainer_init
  SourceBook.Activate
  SaveName = Application.DefaultFilePath & "\img.gif"
  If Dir(SaveName) <> "" Then
      Kill SaveName
  End If
  Range(stRangetoCopi).Select
  Selection.CopyPicture Appearance:=xlScreen, _
      Format:=xlBitmap
  Hi = Selection.Height + 4
  Wi = Selection.Width + 6
  ContainerBook.Activate
  ActiveSheet.ChartObjects(1).Activate
  Call MakeAndSizeChart(ih:=Hi, iv:=Wi)
  ActiveChart.Paste
  ActiveChart.Export Filename:=LCase(SaveName), _
      FilterName:="GIF"
  ActiveChart.Pictures(1).Delete
  SourceBook.Activate
  On Error Resume Next
  Application.StatusBar = False
  ContainerBook.Saved = True
  ContainerBook.Close
End Sub

se evt eksempel

http://www.tbdl.dk/excel/rangeinuserform.xls

Et alternativ hvis du bruger excel XP eller excel 2000 kunne være at bruge en office webcomponent Spreadsheet i din userform.
Her har du mulighed for mange flere ting, men det kræver at de der skal se på det bruger samme version som dig.

Her kan du nøjes med minimal kode og det er lidt hurtigere.
Hvis du har excel XP så prøv at tage et kig på http://www.tbdl.dk/excel/rangeinuserform2.xls

tryk på knappen Vis userform2

YES, det er bare så genialt! det var lige det jeg var ud efter. Det eneste jeg mangler nu, det er hvordan jeg gemmer en graf som *.gif og så et svar fra dig, så du kan få nogle velfortjente point :o)

Hvis du bruger 1. forslag har den allerede genereret en *.gif fil, der ligger i din standardmappe (dokumenter ) og hedder IMG.gif

Takker mange gange :-)))