Creating a chart (using worksheet data) in a userform in VBA in Excel 2013

[kitisn01]

Hi All,

I have been trying to use OWC 11 components in Excel 2013 on a 64-bit operating system to create a chart within a userform (combo box) which has the source linked to my worksheet data with absolutely no luck.

It appears that Microsoft no longer supports OWC 11 components..does anyone know of a work around for this or if this is even possible in Excel 2013? i.e. am I just completely wasting my time?

There is a previous post relating to the matter that appears to have worked in Excel 2003 - I am literally just trying to emulate the same thing i.e. by using the method approach rather than exporting a picture of the chart and linking it to the image within the userform which other users have suggested.

https://www.ozgrid.com/forum/forum/t...-web-component

Many thanks for taking the time to read this!

 

[kitisn01]

Hi Jaafar, I downloaded a similar demo from one of your earlier threads (very cool!) But in this instance the ranges are already defined within the worksheet so I was hoping I could just select the option from the combo box e.g. "chart 2" and the chart would auto update based on the prespecified range.

Ive managed to get the majority of the chart properties sorted now (Y)

 

[Jaafar Tribak]

Hi again,

Demo Workbook

This is a much improved verison of the previous codes :

It enables the user to dynamically and flexibly choose the title of the chart , its source range and the chart type and then displays the chart on a frame on the userform.

No buggy OWC or RefEdit Controls from external libraries are used ... Just simple textboxes and comboboxes from the standard MSForms library.




1- Code in a Standard Module:

Option Explicit

Private Type uPicDesc
    Size As Long
    Type As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
       hPic As Long
       hPal As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type POINTAPI
    X As Long
    Y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal arg1 As LongPtr, ppacc As Any, pvarChild As Variant) As Long
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function OleCreatePictureIndirect64 Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirect32 Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function AccessibleObjectFromPoint Lib "oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function OleCreatePictureIndirect64 Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirect32 Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const CHILDID_SELF = &H0&
Private Const IMAGE_BITMAP = 0
Private Const PICTYPE_BITMAP = 1
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2
Private Const S_OK = 0

Private Enums(70, 2) As Variant '<== Stores XlChartTypes
Private bSetComboFocus As Boolean
Private UForm As Object
Private oSrcRange As Range
Private sngTextBoxTop As Single
Private sngTextBoxLeft As Single
Private sngFormHeight As Single
Private sngFormWidth As Single
Private sFormCaption As String

[COLOR=#008000]'=============[/COLOR]
'[COLOR=#008000][B]Public Routines:[/B][/COLOR]
[COLOR=#008000]'=============[/COLOR]
Public Sub Init(ByVal UF As Object)
    Set UForm = UF
    With UF
        sFormCaption = .Caption
        sngFormHeight = .Height
        sngFormWidth = .Width
        sngTextBoxTop = .txtChartSource.Top
        sngTextBoxLeft = .txtChartSource.Left
        
        .txtChartSource.DropButtonStyle = fmDropButtonStyleReduce
        .txtChartSource.ShowDropButtonWhen = fmShowDropButtonWhenAlways
        .txtChartSource.Font.Bold = True
        .txtChartTitle.Font.Bold = True
        .txtChartSource.ForeColor = vbRed
        .txtChartTitle.ForeColor = vbRed
        .frmChartDisplay.PictureSizeMode = fmPictureSizeModeStretch
        .frmChartDisplay.Caption = ""
        .cbChartType.ForeColor = vbRed
        .cbChartType.Font.Bold = True
        Call FillComboBox(Combo:=UF.cbChartType)
    End With
End Sub

Public Sub PreviewChartType(ByVal UF As Object)
    Static vPrevKid  As Variant
    Dim tCurPos As POINTAPI
    Dim vKid  As Variant
    Dim sBuffer As String, lRet As Long
    
    On Error Resume Next
    GetCursorPos tCurPos
    
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Dim Ptr As LongPtr
        CopyMemory Ptr, tCurPos, LenB(tCurPos)
        Call AccessibleObjectFromPoint(Ptr, Nothing, vKid)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, Nothing, vKid)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Dim lPt As LongPtr, hwnd As LongPtr
        CopyMemory lPt, tCurPos, LenB(tCurPos)
        hwnd = WindowFromPoint(lPt)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hwnd As Long
        hwnd = WindowFromPoint(tCurPos.X, tCurPos.Y)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    sBuffer = Space(256)
    lRet = GetClassName(GetParent(hwnd), sBuffer, 256)
    
    If vKid <> vPrevKid And InStr(Left(sBuffer, lRet), "MdcPopup") Then
        bSetComboFocus = True
        Call UpdateChart(UF:=UF, SourceRange:=oSrcRange, ChartType:=Enums(vKid - 1, 0))
    End If
    
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Dim lPt2 As LongPtr
        CopyMemory lPt2, tCurPos, LenB(tCurPos)
        Call AccessibleObjectFromPoint(lPt2, Nothing, vPrevKid)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Call AccessibleObjectFromPoint(tCurPos.X, tCurPos.Y, Nothing, vPrevKid)
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
End Sub

Public Sub SelectChartSource(ByVal UF As Object)
    Dim sSourceRangeAddrAarray() As String
    Dim oCtrl As Control
    Dim oTotalRanges As Range
    Dim oArea As Range
    Dim item As Long
    Dim lAreasCount As Long

    On Error Resume Next
    With UF
        If .frmChartDisplay.Visible Then
            .Caption = "Select Chart Source Range..."
            For Each oCtrl In .Controls
                If Not oCtrl Is .txtChartSource Then
                    oCtrl.Visible = False
                End If
            Next
            .txtChartSource.Top = 10
            .txtChartSource.Left = 10
            .Height = UF.txtChartSource.Top + .txtChartSource.Height + 30
            .Width = 170
            .txtChartSource.Width = 150
            .txtChartSource.DropButtonStyle = fmDropButtonStyleArrow
            Application.OnTime Now, "StartTimer"
        Else
            Application.OnTime Now, "StopTimer"
            .Caption = sFormCaption
            For Each oCtrl In .Controls
                oCtrl.Visible = True
            Next
            .txtChartSource.Top = sngTextBoxTop
            .txtChartSource.Left = sngTextBoxLeft
            .Height = sngFormHeight
            .Width = sngFormWidth
            .txtChartSource.DropButtonStyle = fmDropButtonStyleReduce
            Set oTotalRanges = Nothing
            sSourceRangeAddrAarray = Split(.txtChartSource.Text, ",")
            For lAreasCount = 1 To Selection.Areas.Count
                Set oArea = Selection.Areas(lAreasCount)
                If oTotalRanges Is Nothing Then
                    Set oSrcRange = Union(oArea, oArea)
                    Set oTotalRanges = oSrcRange
                    lAreasCount = 1
                    GoTo Nxt
                End If
                Set oSrcRange = Union(oTotalRanges, oArea)
Nxt:
                Set oTotalRanges = oSrcRange
            Next
            UpdateChart UF, oTotalRanges, .cbChartType.Value
        End If
    End With
End Sub

Public Sub UpdateTheChart(ByVal UF As Object)
    UpdateChart UF, oSrcRange, UF.cbChartType.Value
End Sub

Public Sub ChangeChartType(ByVal UF As Object)
    Dim lCharType As XlChartType
    If Not oSrcRange Is Nothing Then
        If UF.cbChartType.ListCount = UBound(Enums, 1) + 1 Then
            lCharType = IIf(UF.cbChartType.ListIndex = -1, xlLine, UF.cbChartType.Value)
            bSetComboFocus = True
            Call UpdateChart(UF:=UF, SourceRange:=oSrcRange, ChartType:=lCharType)
        End If
    End If
End Sub

Public Sub FormClose()
    KillTimer Application.hwnd, 0
    Set oSrcRange = Nothing
End Sub

[COLOR=#008000]'===================[/COLOR]
[B][COLOR=#008000]'Private routines...[/COLOR][/B]
[COLOR=#008000]'==================[/COLOR]

Private Sub UpdateChart(ByVal UF As Object, ByVal SourceRange As Range, ByVal ChartType As XlChartType)
    Static oChart As ChartObject
    
    On Error Resume Next
    oChart.Delete
    Set oChart = CreateChart(UF, SourceRange, ChartType)
    If Err.Number = 0 Then
        Set UF.frmChartDisplay.Picture = CreatePicture(oChart)
    End If
    oChart.Delete
    SourceRange.Select
    If bSetComboFocus Then
        bSetComboFocus = False
        UF.cbChartType.SetFocus
    End If
End Sub
    
Private Function CreateChart(ByVal UF As Object, ByVal SourceDataRange As Range, ByVal ChartType As XlChartType) As ChartObject
    On Error Resume Next
    Application.ScreenUpdating = False
    SourceDataRange.Cells(1).Select
    SourceDataRange.Parent.Shapes.AddChart.Select
    With ActiveChart
        .ChartType = ChartType
        .HasTitle = True
        .ChartTitle.Select
        .ChartTitle.Text = UF.txtChartTitle.Text
        .SetSourceData Source:=SourceDataRange, PlotBy:=xlColumns
        Set CreateChart = .Parent
    End With
End Function

Private Function CreatePicture(ByVal Chart As ChartObject) As IPicture
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
        Dim hCopy As LongPtr, hPtr As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Dim hCopy As Long, hPtr As Long
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    
    Dim lRet As Long
    Dim IID_IDispatch As GUID
    Dim uPicinfo As uPicDesc
    Dim iPic As IPicture

    Chart.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    CloseClipboard
    
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hCopy
        .hPal = 0
    End With

    If InStr(1, Application.OperatingSystem, "32-bit") Then
        lRet = OleCreatePictureIndirect32(uPicinfo, IID_IDispatch, True, iPic)
    End If
    
    If InStr(1, Application.OperatingSystem, "64-bit") Then
        lRet = OleCreatePictureIndirect64(uPicinfo, IID_IDispatch, True, iPic)
    End If
    
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
End Function

Private Sub TimerProc()
    On Error Resume Next
    Call StopTimer
    If GetAsyncKeyState(VBA.vbKeyEscape) Then
        UForm.frmChartDisplay.Visible = False
        Call SelectChartSource(UForm)
        UForm.frmChartDisplay.SetFocus
        Exit Sub
    End If
    UForm.txtChartSource.Text = Selection.Address
    Call StartTimer
End Sub

Private Sub StartTimer()
    SetTimer Application.hwnd, 0, 0, AddressOf TimerProc
End Sub

Private Sub StopTimer()
    KillTimer Application.hwnd, 0
End Sub

Private Sub FillComboBox(ByVal Combo As ComboBox)
    Enums(0, 0) = -4098:     Enums(0, 1) = "xl3DArea"
    Enums(1, 0) = 78:        Enums(1, 1) = "xl3DAreaStacked"
    Enums(2, 0) = 79:        Enums(2, 1) = "xl3DAreaStacked100"
    Enums(3, 0) = 60:        Enums(3, 1) = "xl3DBarClustered"
    Enums(4, 0) = 61:        Enums(4, 1) = "xl3DBarStacked"
    Enums(5, 0) = 62:        Enums(5, 1) = "xl3DBarStacked100"
    Enums(6, 0) = -4100:     Enums(6, 1) = "xl3DColumn"
    Enums(7, 0) = 54:        Enums(7, 1) = "xl3DColumnClustered"
    Enums(8, 0) = 55:        Enums(8, 1) = "xl3DColumnStacked"
    Enums(9, 0) = 56:        Enums(9, 1) = "xl3DColumnStacked100"
    Enums(10, 0) = -4101:    Enums(10, 1) = "xl3DLine"
    Enums(11, 0) = -4102:    Enums(11, 1) = "xl3DPie"
    Enums(12, 0) = 70:       Enums(12, 1) = "xl3DPieExploded"
    Enums(13, 0) = 1:        Enums(13, 1) = "xlArea"
    Enums(14, 0) = 76:       Enums(14, 1) = "xlAreaStacked"
    Enums(15, 0) = 77:       Enums(15, 1) = "xlAreaStacked100"
    Enums(16, 0) = 57:       Enums(16, 1) = "xlBarClustered"
    Enums(17, 0) = 71:       Enums(17, 1) = "xlBarOfPie"
    Enums(18, 0) = 58:       Enums(18, 1) = "xlBarStacked"
    Enums(19, 0) = 59:       Enums(19, 1) = "xlBarStacked100"
    Enums(20, 0) = 15:       Enums(20, 1) = "xlBubble"
    Enums(21, 0) = 87:       Enums(21, 1) = "xlBubble3DEffect"
    Enums(22, 0) = 51:       Enums(22, 1) = "xlColumnClustered"
    Enums(23, 0) = 52:       Enums(23, 1) = "xlColumnStacked"
    Enums(24, 0) = 53:       Enums(24, 1) = "xlColumnStacked100"
    Enums(25, 0) = 102:      Enums(25, 1) = "xlConeBarClustered"
    Enums(26, 0) = 103:      Enums(26, 1) = "xlConeBarStacked"
    Enums(27, 0) = 104:      Enums(27, 1) = "xlConeBarStacked100"
    Enums(28, 0) = 105:      Enums(28, 1) = "xlConeCol"
    Enums(29, 0) = 99:       Enums(29, 1) = "xlConeColClustered"
    Enums(30, 0) = 100:      Enums(30, 1) = "xlConeColStacked"
    Enums(31, 0) = 101:      Enums(31, 1) = "xlConeColStacked100"
    Enums(32, 0) = 95:       Enums(32, 1) = "xlCylinderBarClustered"
    Enums(33, 0) = 96:       Enums(33, 1) = "xlCylinderBarStacked"
    Enums(34, 0) = 97:       Enums(34, 1) = "xlCylinderBarStacked100"
    Enums(35, 0) = 98:       Enums(35, 1) = "xlCylinderCol"
    Enums(36, 0) = 92:       Enums(36, 1) = "xlCylinderColClustered"
    Enums(37, 0) = 93:       Enums(37, 1) = "xlCylinderColStacked"
    Enums(38, 0) = 94:       Enums(38, 1) = "xlCylinderColStacked100"
    Enums(39, 0) = -4120:    Enums(39, 1) = "xlDoughnut"
    Enums(40, 0) = 80:       Enums(40, 1) = "xlDoughnutExploded"
    Enums(41, 0) = 4:        Enums(41, 1) = "xlLine"
    Enums(42, 0) = 65:       Enums(42, 1) = "xlLineMarkers"
    Enums(43, 0) = 66:       Enums(43, 1) = "xlLineMarkersStacked"
    Enums(44, 0) = 67:       Enums(44, 1) = "xlLineMarkersStacked100"
    Enums(45, 0) = 63:       Enums(45, 1) = "xlLineStacked"
    Enums(46, 0) = 64:       Enums(46, 1) = "xlLineStacked100"
    Enums(47, 0) = 5:        Enums(47, 1) = "xlPie"
    Enums(48, 0) = 69:       Enums(48, 1) = "xlPieExploded"
    Enums(49, 0) = 68:       Enums(49, 1) = "xlPieOfPie"
    Enums(50, 0) = 109:      Enums(50, 1) = "xlPyramidBarClustered"
    Enums(51, 0) = 110:      Enums(51, 1) = "xlPyramidBarStacked"
    Enums(52, 0) = 111:      Enums(52, 1) = "xlPyramidBarStacked100"
    Enums(53, 0) = 112:      Enums(53, 1) = "xlPyramidCol"
    Enums(54, 0) = 106:      Enums(54, 1) = "xlPyramidColClustered"
    Enums(55, 0) = 107:      Enums(55, 1) = "xlPyramidColStacked"
    Enums(56, 0) = 108:      Enums(56, 1) = "xlPyramidColStacked100"
    Enums(57, 0) = -4151:    Enums(57, 1) = "xlRadar"
    Enums(58, 0) = 82:       Enums(58, 1) = "xlRadarFilled"
    Enums(59, 0) = 81:       Enums(59, 1) = "xlRadarMarkers"
    Enums(60, 0) = 88:       Enums(60, 1) = "xlStockHLC"
    Enums(61, 0) = 89:       Enums(61, 1) = "xlStockOHLC"
    Enums(62, 0) = 90:       Enums(62, 1) = "xlStockVHLC"
    Enums(63, 0) = 91:       Enums(63, 1) = "xlStockVOHLC"
    Enums(64, 0) = 83:       Enums(64, 1) = "xlSurface"
    Enums(65, 0) = 85:       Enums(65, 1) = "xlSurfaceTopView"
    Enums(66, 0) = 86:       Enums(66, 1) = "xlSurfaceTopViewWireframe"
    Enums(67, 0) = 84:       Enums(67, 1) = "xlSurfaceWireframe"
    Enums(68, 0) = -4169:    Enums(68, 1) = "xlXYScatter"
    Enums(69, 0) = 74:       Enums(69, 1) = "xlXYScatterLines"
    Enums(70, 0) = 75:       Enums(70, 1) = "xlXYScatterLinesNoMarkers"
    
    With Combo
        .ColumnCount = 2
        .BoundColumn = 1
        .List = Enums
        .ColumnWidths = "0pt;100pt"
        .ListIndex = 41
    End With
End Sub

2- Code in the UserForm Module:

Option Explicit

Private WithEvents wb As Workbook

Private Sub UserForm_Initialize()
    Set wb = ThisWorkbook
    Call Init(Me)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Call FormClose
End Sub

Private Sub cbChartType_Change()
    Call ChangeChartType(Me)
End Sub

Private Sub cbChartType_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call PreviewChartType(Me)
End Sub

Private Sub txtChartSource_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode <> 9 Then KeyCode = 0
End Sub

Private Sub txtChartSource_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call SelectChartSource(Me)
    lblChartDisplay.Visible = False
End Sub

Private Sub txtChartTitle_AfterUpdate()
    Call UpdateTheChart(Me)
End Sub

Private Sub cmbClose_Click()
    Unload Me
End Sub

Private Sub wb_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Call UpdateTheChart(Me)
End Sub

Code written in excel 2010 (64bit)/Windows10- (64 bit) and also tested on excel 2007.

 

[Ingolf]

Hi Jaafar,

Every time when I try to change chart type, appear a message "excel is stoped working" and excel close and restart alone. Tried many times, same error...
I use win 10 and office 365.

 

[Jaafar Tribak]

Hi Jaafar,

Every time when I try to change chart type, appear a message "excel is stoped working" and excel close and restart alone. Tried many times, same error...
I use win 10 and office 365.

I wouldn't be able to know because I don't have access to office 365 to carry out a test.

I hope others can test the code on different platforms and see if it works ok.

 

[kitisn01]

Hi Jaafar,

Thanks for this! I just downloaded and tested the workbook on Excel 2013 and it works absolutely fine!

Have you had any ideas as to how we could show different charts within the same userform via the use of a drop down menu? (using the same code as you had before that doesn't write a temporary gif file each time you want to see the chart?)

I've had a go with not much luck thus far,

Thanks

 

[Jaafar Tribak]

Hi Jaafar,

Thanks for this! I just downloaded and tested the workbook on Excel 2013 and it works absolutely fine!

Have you had any ideas as to how we could show different charts within the same userform via the use of a drop down menu? (using the same code as you had before that doesn't write a temporary gif file each time you want to see the chart?)

I've had a go with not much luck thus far,

Thanks

1- My last code doesn't write a temporary gif file to disk or any other file for that matter.

2- You can also show different charts within the same useform just by selecting with the mouse their respective SourceRange cells on the worksheet... Add a second table to the worksheet and try it.

 

[kitisn01]

Hi Jaafar,

That's what I said in my previous post "using the same code as you had before that doesn't write a temporary gif file" i.e. your code doesn't do this which is perfect.

I'll have a go at generating the user form later today and update accordingly (Y)

Thanks again for all your help!