charts on a User Form?

J

jamiguel77

Active Member
Joined
Feb 14, 2006
Messages
387
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
  2. Web
i am interested on draw charts on a USer form, specially in a Multipagecontrol, how to do?

Thanks
 
Sort by date Sort by votes
@Jaafar Tribak your sample work fine. and its ok.... thanks for sample.

Only a duda, how to apply this technique for all Charts? (in my case, 6 by moment).

Thanks
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
@Jaafar Tribak

Adapting your code, to a graph..

the process: opened 2 workbooks:

Code: 
  Set wbk2 = Workbooks.Open(FileName:=F2)
  Set wbk = Workbooks.Open(FileName:=F1)

and in :

Code: 
Private Sub SetUpChart()
    Dim oChart As ChartObject, oPoint As Point, i As Long
    On Error GoTo erHandler
    Set NewSheet = wbk.Sheets("Graficas")
    Chart_Source_Range = NewSheet.Range("K66:L78")

this line: Chart_Source_Range = NewSheet.Range("K66:L78")

generate a error and go to here:

Code: 
erHandler:
    oChart.Delete
    Application.EnableEvents = True
End Sub

i cant setup the range same as here:

Private Const Chart_Source_Range = "Sheet1!$A$1:$B$9"

because i need specify the workbook name stored on F1.Text

Any advice how to fix this error?

Thanks
 
Upvote 0
at this moment i havent problem generating Chart (copied your code)... and work Fine, now all my graphs at moment work fine.

Code: 
Private Function CreateChart(ByVal SourceDataRange As Range, ByVal ChartType As XlChartType) As ChartObject
    SourceDataRange.Parent.Shapes.AddChart.Select
    With ActiveChart
        .ChartType = ChartType
        .SetSourceData Source:=SourceDataRange
        .SeriesCollection(1).ApplyDataLabels
        .Parent.Height = Me.Frame1.Height
        .Parent.Width = Me.Frame1.Width
        With .Parent.Chart.Legend.Format.TextFrame2.TextRange.Font
            .BaselineOffset = 0
            .Spacing = -1
        End With
        Set CreateChart = .Parent
    End With
End Function

saved my life.......


here the video of my Work(and you @JAAFAR ( https://1drv.ms/v/s!AmG2fH_7hMOEmSbUEfm2VV9UL54M )


i am resume points to be resolved:

1) How to apply your code/technique to all Charts?
2) how to specify the range on this line:
Code: 
Private Sub SetUpChart()
    Dim oChart As ChartObject, oPoint As Point, i As Long
    On Error GoTo erHandler
    Set NewSheet = wbk.Sheets("Graficas")
    'Range("A1:B1").Select
    Chart_Source_Range = NewSheet.Range("K66:L78")

Last line not work.

Thanks


Much Thanks
 
Upvote 0
@jamiguel77

Sorry for the late response ... You want to apply the code to several charts - Right ?

If so, are they all going to be xlDoughnut chartype ? And do you want them to be placed on the same frame ?
 
Last edited:
Upvote 0
NdNoviceHlp said:
"I gave this a shot"... I was sure hoping that U would Jaafar... that is some cool stuff. Is it possible to get the hover tool tip thing to work for a series in a scatter chart? I would have some use for that. If U think it is, I would have a go at it, being that I would like to learn a bit more about API coding.
Click to expand...

@NdNoviceHlp

Sorry for the late response.

Hi, I remember wanting to display a tooltip with the info when hovering over Points on column-charts but never got around finishing the code.

I think, it will be easier to do for scatter charts .. I'll give it a try and see if anything comes up.
 
Upvote 0
@jamiguel77

Here is a variation of the code in post#15.

This new version is more flexible in that it works for multiple charts that's why I have placed the code in a Class Module.

Workbook Example

The following code places 3 charts each in its own frame .. Each frame is located in its own Page in a Multipage.


1- Class Module Code : CUserFormChart
Code: 
Option Explicit

Private WithEvents ws As Worksheet
Private WithEvents oFrame   As MSForms.Frame
Private oSrcRange As Range
Private lChrType As XlChartType

Private Type POINTAPI
        X As Long
        Y As Long
End Type

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

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal X As Long, ByVal Y As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
    Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private hCopy As LongPtr, hPtr As LongPtr, hdc As LongPtr, hLib As LongPtr

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private hCopy As Long, hPtr As Long, hdc As Long, hLib As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If


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 Const COLOR_INFOBK = 24

Private arrColors() As Variant
Private arrColorNames() As Variant
Private arrLabelValues() As String
Private oLbl As MSForms.Label


Public Property Set SourceRange(ByVal SrcRange As Range)
    Set oSrcRange = SrcRange
End Property

Public Property Let ChartType(ByVal ChrType As Variant)
    lChrType = ChrType
    If lChrType <> xlDoughnut And lChrType <> xlPie Then MsgBox "Only 'xlDoughnut' and 'xlPie' charts are allowed.", vbExclamation: End
End Property

Public Property Set FrameHost(ByVal Frm As MSForms.Frame)
    Set oFrame = Frm
End Property

Public Sub Execute()
    If Not oSrcRange Is Nothing And Not oFrame Is Nothing And lChrType Then
        Call SetUpChart
    End If
End Sub

Private Sub oFrame_Click()
    Dim tCurPos As POINTAPI, lPixColor As Long
    Dim sColor As String, sValue As String, lErr As Long
    
    If oFrame.Parent.Parent.Parent.OptionButton1.Value = -1 Then
        Call GetValues(sColor, sValue, lErr)
        If sColor <> "White" Then
            MsgBox "Color : " & sColor & vbCr & "Value : " & sValue, vbInformation
        End If
    End If

End Sub

Private Sub oFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim sColor As String, sValue As String, lErr As Long
    
    If oFrame.Parent.Parent.Parent.OptionButton1.Value = 0 Then
        Call GetValues(sColor, sValue, lErr)
        With oLbl
        If lErr = 0 Then
            .Caption = "Color : " & sColor & vbCr & "Value : " & sValue
            .Visible = 1
            .BackColor = GetSysColor(COLOR_INFOBK)
            .BorderStyle = fmBorderStyleSingle
            .Left = X
            .Top = Y - 30
            .Font.Bold = True
            .Height = 25  [B][COLOR=#008000]'<== may need adjusting depending on lenghth of the caption text[/COLOR][/B]
            .Width = 80   [COLOR=#008000][B]'<== may need adjusting depending on lenghth of the caption text[/B][/COLOR]
        End If
        If sColor = "White" Then
            .Visible = 0
        End If
        End With
    End If

End Sub

Private Sub SetUpChart()

    Dim oChart As ChartObject, oPoint As Point, i As Long

    On Error GoTo erHandler
    oFrame.Caption = ""
    oFrame.Parent.Parent.Parent.OptionButton1.Value = 1
    Application.EnableEvents = False
    oSrcRange.Parent.Select
    Application.EnableEvents = True
    Set ws = oSrcRange.Parent
    Set oLbl = oFrame.Controls.Add("Forms.Label.1", "Test", 0)
    Set oChart = CreateChart(oSrcRange, lChrType)
    arrColors = Array(255, 15773696, 5287936, 65535, 10498160, 16776960, 16711935, 49407, 192, 5296274, 16777215, 16711680, 8421504, 0)
    arrColorNames = Array("Red", "Light Blue", "Green", "Yellow", "Purple", "Cyan", "Pink", "Orange", "Dark Red", "Light Green", "White", "Blue", "Grey", "Black")
    For i = 1 To oChart.Chart.SeriesCollection(1).Points.Count
        ReDim Preserve arrLabelValues(i)
        arrLabelValues(i) = oChart.Chart.SeriesCollection(1).Points(i).DataLabel.Caption
        oChart.Chart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = arrColors(i - 1)
    Next
    Set oFrame.Picture = CreatePicture(oChart)
erHandler:
    oChart.Delete
    Application.EnableEvents = True
End Sub

Private Sub GetValues(ByRef Color As String, ByRef Value As String, ByRef ErrorNumber As Long)

    Static tCurPos As POINTAPI
    Static lPixColor As Long
    
    On Error Resume Next
    hdc = GetDC(0)
    GetCursorPos tCurPos
    lPixColor = GetPixel(GetDC(0), tCurPos.X, tCurPos.Y)
    ReleaseDC 0, hdc
    Color = arrColorNames(Application.Match(lPixColor, arrColors, 0) - 1)
    Value = arrLabelValues(Application.Match(lPixColor, arrColors, 0))
    ErrorNumber = Err.Number
End Sub
                
Private Function CreateChart(ByVal SourceDataRange As Range, ByVal ChartType As XlChartType) As ChartObject
    SourceDataRange.Parent.Shapes.AddChart.Select
    With ActiveChart
         .Parent.Height = oFrame.Height
        .Parent.Width = oFrame.Width
        .ChartType = ChartType
        .SetSourceData Source:=oSrcRange
        .SeriesCollection(1).ApplyDataLabels
        With .Parent.Chart.Legend.Format.TextFrame2.TextRange.Font
            .BaselineOffset = 0
            .Spacing = -1
        End With
        Set CreateChart = .Parent
    End With
End Function
    
Private Function CreatePicture(ByVal Chart As ChartObject) As IPicture

    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
    Dim iPic As IPicture, lRet As Long
    
    On Error GoTo errHandler
    Chart.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    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
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, iPic)
    Else
        lRet = OleCreatePictureIndirectPro(uPicinfo, IID_IDispatch, True, iPic)
    End If
    FreeLibrary hLib
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
errHandler:
    EmptyClipboard
    CloseClipboard
End Function

Private Sub ws_Change(ByVal Target As Range)
    If Not Intersect(Target, oSrcRange) Is Nothing Then
        Call SetUpChart
    End If
End Sub

2- Code in the UserForm Module :
Code: 
Option Explicit

Private oChart1 As CUserFormChart
Private oChart2 As CUserFormChart
Private oChart3 As CUserFormChart

Private Sub UserForm_Initialize()

    Set oChart1 = New CUserFormChart
    Set oChart2 = New CUserFormChart
    Set oChart3 = New CUserFormChart
    
    With Me.MultiPage1
        .Pages(0).Caption = "Chart 1"
        .Pages(1).Caption = "Chart 2"
        .Pages(2).Caption = "Chart 3"
        .Value = 0
    End With
    
    With oChart1
        Set .FrameHost = Me.MultiPage1.Pages(0).Frame1
        Set .SourceRange = Sheet1.Range("A1:B9")
        .ChartType = xlDoughnut
        .Execute
    End With

    With oChart2
        Set .FrameHost = Me.MultiPage1.Pages(1).Frame2
        Set .SourceRange = Sheet1.Range("A12:B20")
        .ChartType = xlPie
        .Execute
    End With
'
    With oChart3
        Set .FrameHost = Me.MultiPage1.Pages(2).Frame3
        Set .SourceRange = Sheet1.Range("A23:B31")
        .ChartType = xlDoughnut
        .Execute
    End With

End Sub
 
Last edited:
Upvote 0
I forgot to include the possibility to add a chart title in the previous code .. So please, ignore the previous code and use the following one to which I have added a new optional Property (ChartTitle) in the generic Class.

Workbook example

1- Code the Class Module : (CUserFormChart)
Code: 
Option Explicit

Private WithEvents ws As Worksheet
Private WithEvents oFrame   As MSForms.Frame
Private oSrcRange As Range
Private lChrType As XlChartType
Private sTitle As String

Private Type POINTAPI
        X As Long
        Y As Long
End Type

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

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As LongPtr, ByVal X As Long, ByVal Y As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
    Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private hCopy As LongPtr, hPtr As LongPtr, hdc As LongPtr, hLib As LongPtr

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    
    Private hCopy As Long, hPtr As Long, hdc As Long, hLib As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

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 Const COLOR_INFOBK = 24

Private arrColors() As Variant
Private arrColorNames() As Variant
Private arrLabelValues() As String
Private oLbl As MSForms.Label


Public Property Set SourceRange(ByVal SrcRange As Range)
    Set oSrcRange = SrcRange
End Property

Public Property Let ChartType(ByVal ChrType As Variant)
    lChrType = ChrType
    If lChrType <> xlDoughnut And lChrType <> xlPie Then MsgBox "Only 'xlDoughnut' and 'xlPie' charts are allowed.", vbExclamation: End
End Property

Public Property Let ChartTitle(ByVal Title As String)
    sTitle = Title
End Property

Public Property Set FrameHost(ByVal Frm As MSForms.Frame)
    Set oFrame = Frm
End Property

Public Sub Execute()
    If Not oSrcRange Is Nothing And Not oFrame Is Nothing And lChrType Then
        Call SetUpChart
    End If
End Sub

Private Sub oFrame_Click()
    Dim tCurPos As POINTAPI, lPixColor As Long
    Dim sColor As String, sValue As String, lErr As Long
    
    If oFrame.Parent.Parent.Parent.OptionButton1.Value = -1 Then
        Call GetValues(sColor, sValue, lErr)
        If sColor <> "White" Then
            MsgBox "Color : " & sColor & vbCr & "Value : " & sValue, vbInformation
        End If
    End If

End Sub

Private Sub oFrame_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim sColor As String, sValue As String, lErr As Long
    
    If oFrame.Parent.Parent.Parent.OptionButton1.Value = 0 Then
        Call GetValues(sColor, sValue, lErr)
        With oLbl
        If lErr = 0 Then
            .Caption = "Color : " & sColor & vbCr & "Value : " & sValue
            .Visible = 1
            .BackColor = GetSysColor(COLOR_INFOBK)
            .BorderStyle = fmBorderStyleSingle
            .Left = X
            .Top = Y - 30
            .Font.Bold = True
            .Height = 25  [B][COLOR=#008000]'<== may need adjusting depending on lenghth of the caption text[/COLOR][/B]
            .Width = 80   [B][COLOR=#008000]'<== may need adjusting depending on lenghth of the caption text[/COLOR][/B]
        End If
        If sColor = "White" Then
            .Visible = 0
        End If
        End With
    End If

End Sub

Private Sub SetUpChart()

    Dim oChart As ChartObject, oPoint As Point, i As Long

    On Error GoTo erHandler
    oFrame.Caption = ""
    oFrame.Parent.Parent.Parent.OptionButton1.Value = 1
    Application.EnableEvents = False
    oSrcRange.Parent.Select
    Application.EnableEvents = True
    Set ws = oSrcRange.Parent
    Set oLbl = oFrame.Controls.Add("Forms.Label.1", "Test", 0)
    Set oChart = CreateChart(oSrcRange, lChrType)
    arrColors = Array(255, 15773696, 5287936, 65535, 10498160, 16776960, 16711935, 49407, 192, 5296274, 16777215, 16711680, 8421504, 0)
    arrColorNames = Array("Red", "Light Blue", "Green", "Yellow", "Purple", "Cyan", "Pink", "Orange", "Dark Red", "Light Green", "White", "Blue", "Grey", "Black")
    For i = 1 To oChart.Chart.SeriesCollection(1).Points.Count
        ReDim Preserve arrLabelValues(i)
        arrLabelValues(i) = oChart.Chart.SeriesCollection(1).Points(i).DataLabel.Caption
        oChart.Chart.SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = arrColors(i - 1)
    Next
    Set oFrame.Picture = CreatePicture(oChart)
erHandler:
    oChart.Delete
    Application.EnableEvents = True
End Sub

Private Sub GetValues(ByRef Color As String, ByRef Value As String, ByRef ErrorNumber As Long)

    Static tCurPos As POINTAPI
    Static lPixColor As Long
    
    On Error Resume Next
    hdc = GetDC(0)
    GetCursorPos tCurPos
    lPixColor = GetPixel(GetDC(0), tCurPos.X, tCurPos.Y)
    ReleaseDC 0, hdc
    Color = arrColorNames(Application.Match(lPixColor, arrColors, 0) - 1)
    Value = arrLabelValues(Application.Match(lPixColor, arrColors, 0))
    ErrorNumber = Err.Number
End Sub
                
Private Function CreateChart(ByVal SourceDataRange As Range, ByVal ChartType As XlChartType) As ChartObject
    SourceDataRange.Parent.Shapes.AddChart.Select
    With ActiveChart
         .Parent.Height = oFrame.Height
        .Parent.Width = oFrame.Width
        .ChartType = ChartType
        .SetSourceData Source:=SourceDataRange
        .SetElement (msoElementChartTitleAboveChart)
        .ChartTitle.Text = sTitle
        .SeriesCollection(1).ApplyDataLabels
        With .Parent.Chart.Legend.Format.TextFrame2.TextRange.Font
            .BaselineOffset = 0
            .Spacing = -1
        End With
        Set CreateChart = .Parent
    End With
End Function
    
Private Function CreatePicture(ByVal Chart As ChartObject) As IPicture

    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
    Dim iPic As IPicture, lRet As Long
    
    On Error GoTo errHandler

    Chart.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    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
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, iPic)
    Else
        lRet = OleCreatePictureIndirectPro(uPicinfo, IID_IDispatch, True, iPic)
    End If
    FreeLibrary hLib
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
errHandler:
    EmptyClipboard
    CloseClipboard
End Function

Private Sub ws_Change(ByVal Target As Range)
    If Not Intersect(Target, oSrcRange) Is Nothing Then
        Call SetUpChart
    End If
End Sub

2- Code in the UserForm Module :
Code: 
Option Explicit

Private oChart1 As CUserFormChart
Private oChart2 As CUserFormChart
Private oChart3 As CUserFormChart

Private Sub UserForm_Initialize()

    Set oChart1 = New CUserFormChart
    Set oChart2 = New CUserFormChart
    Set oChart3 = New CUserFormChart
    
    With Me.MultiPage1
        .Pages(0).Caption = "Chart 1"
        .Pages(1).Caption = "Chart 2"
        .Pages(2).Caption = "Chart 3"
        .Value = 0
    End With
    
    With oChart1
        Set .FrameHost = Me.MultiPage1.Pages(0).Frame1
        Set .SourceRange = Sheet1.Range("A2:B9")
        .ChartType = xlDoughnut
        .ChartTitle = Range("A1").Text
        .Execute
    End With

    With oChart2
        Set .FrameHost = Me.MultiPage1.Pages(1).Frame2
        Set .SourceRange = Sheet1.Range("A13:B20")
        .ChartType = xlPie
        .ChartTitle = Range("A12").Text
        .Execute
    End With
'
    With oChart3
        Set .FrameHost = Me.MultiPage1.Pages(2).Frame3
        Set .SourceRange = Sheet1.Range("A24:B31")
        .ChartType = xlDoughnut
        .ChartTitle = Range("A23").Text
        .Execute
    End With

End Sub
 
Last edited:
Upvote 0
@NdNoviceHlp

Here is the code for getting the hover tool tip thing to work for a series in a scatter chart.

Tested on Excel 2010 64bit Win10 64bit

Workbook Example





1- Class Module Code (CUserFormChart)
Code: 
Option Explicit

Private WithEvents oWs As Worksheet
Private WithEvents Frm As MSForms.Frame
Private oChartSourceRange As Range
Private lCharYype As XlChartType
Private sTitle As String
Private bShowHoverToolTip As Boolean

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

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

[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 PtInRect Lib "user32" (lpRect As RECT, ByVal arg2 As LongPtr) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Private Declare PtrSafe Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) 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 GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

    Private hCopy As LongPtr, hPtr As LongPtr, hLib As LongPtr

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 

    Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro 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 EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

    Private hCopy As Long, hPtr As Long, hLib As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const TOOLTIP_WIDTH = 135  [B][COLOR=#008000]'<== Const may need adjusting depending on lenghth of the caption text[/COLOR][/B]
Private Const TOOLTIP_HEIGHT = 25   [COLOR=#008000][B]'<== Const may need adjusting depending on lenghth of the caption text[/B][/COLOR]

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 Const COLOR_INFOBK = 24

Private oLbl As MSForms.Label
Private arrMarkersRects() As RECT
Private arrTipTexts() As String


Public Property Set FrameHost(ByVal Frame As MSForms.Frame)
    Set Frm = Frame
End Property

Public Property Set SourceRange(ByVal SourceRange As Range)
    Set oChartSourceRange = SourceRange
End Property

Public Property Let ChartType(ByVal ChType As XlChartType)
    lCharYype = ChType
End Property

Public Property Let ChartTitle(ByVal Title As String)
    sTitle = Title
End Property

Public Property Let ShowHoverToolTip(ByVal Show As Boolean)
    bShowHoverToolTip = Show
End Property

Public Sub Execute()
    If Not oChartSourceRange Is Nothing And Not Frm Is Nothing And lCharYype Then
        Call SetUpChart(oChartSourceRange, lCharYype, bShowHoverToolTip)
    Else
        MsgBox "Oops!" & vbCr & vbCr & "Verify that the Frame name, the Chart SourceRange and the ChartType are all correct", vbExclamation, "Error !"
    End If
End Sub

Private Sub Frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Static bTipShowing As Boolean
    Dim p As POINTAPI, i As Long

    If bShowHoverToolTip Then
    
        p.X = X: p.Y = Y
        For i = 0 To UBound(arrMarkersRects)
        
        [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
                Dim lngPtr As LongPtr
                CopyMemory lngPtr, p, LenB(p)
                If PtInRect(arrMarkersRects(i), lngPtr) Then
            [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=Else"]#Else[/URL] 
            If PtInRect(arrMarkersRects(i), X, Y) Then
        [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
                If bTipShowing = False Then
                    bTipShowing = True
                    Call ShowToolTip(arrTipTexts(i), X, Y)
                End If
                Exit Sub
            End If
        Next
        If bTipShowing = True Then
            oLbl.Visible = False
            bTipShowing = False
        End If
    
    End If
End Sub

Private Sub ShowToolTip(ByVal msg As String, ByVal X As Single, ByVal Y As Single)

    With oLbl
            .Caption = msg
            .Visible = 1
            .BackColor = GetSysColor(COLOR_INFOBK)
            .BorderStyle = fmBorderStyleSingle
            .Width = TOOLTIP_WIDTH [B][COLOR=#008000]' <== may need adjusting depending on lenghth of the caption text[/COLOR][/B]
            .Height = TOOLTIP_HEIGHT [B][COLOR=#008000]' <== may need adjusting depending on lenghth of the caption text[/COLOR][/B]
            .Left = X
            .Top = Y - 30
        End With
End Sub

Private Sub SetUpChart(ByVal SourceRange As Range, ByVal ChartType As XlChartType, ByVal HoverTip As Boolean)

    Dim tRect As RECT
    Dim vXValues As Variant, vValues As Variant
    Dim sngLeft As Single, sngTop As Single
    Dim i As Integer, j As Integer, iNextFirstPointIndex As Integer
    Dim sToolTipText As String
    
    On Error GoTo errHandler
    
    Frm.Caption = ""
    Application.EnableEvents = False
    SourceRange.Parent.Select
    Application.EnableEvents = True
    Set oLbl = Frm.Controls.Add("Forms.Label.1", "", 0)
    Set oWs = SourceRange.Parent
    SourceRange.Parent.Shapes.AddChart.Select
    
    With ActiveChart
        .SetSourceData Source:=SourceRange
        .ChartType = ChartType
        .SetElement (msoElementChartTitleAboveChart)
        .ChartTitle.Text = sTitle
        .Parent.Height = Frm.Height
        .Parent.Width = Frm.Width
        With .Parent.Chart.Legend.Format.TextFrame2.TextRange.Font
            .BaselineOffset = 0
            .Spacing = -1
        End With
           
        For i = 1 To .SeriesCollection.Count
        
            For j = 1 To .SeriesCollection(i).Points.Count
            
                sngLeft = ExecuteExcel4Macro("GET.CHART.ITEM(1,1,""S" & i & "P" & j & """)")
                sngTop = ExecuteExcel4Macro("GET.CHART.ITEM(2,1,""S" & i & "P" & j & """)")
                sngTop = (.ChartArea.Height - sngTop)
                
                vXValues = .SeriesCollection(i).XValues
                vValues = .SeriesCollection(i).Values
                
                ReDim Preserve arrMarkersRects(j + iNextFirstPointIndex)
                ReDim Preserve arrTipTexts(j + iNextFirstPointIndex)
                
                With tRect
                    .Left = sngLeft: .Top = sngTop
                    .Right = sngLeft + ActiveChart.SeriesCollection(i).MarkerSize: .Bottom = sngTop + ActiveChart.SeriesCollection(i).MarkerSize
                    arrMarkersRects(j + iNextFirstPointIndex) = tRect
                End With
                
                sToolTipText = "  Serie " & Chr(34) & .SeriesCollection(i).Name & Chr(34) & " Point " & Chr(34) & SourceRange(j + 1, 1) & Chr(34) _
                & vbNewLine & "  (" & vXValues(j) & "," & vValues(j) & ")"
                arrTipTexts(j + iNextFirstPointIndex) = sToolTipText
                
            Next j
            
            iNextFirstPointIndex = iNextFirstPointIndex + .SeriesCollection(i).Points.Count
        Next i
        
        Set Frm.Picture = CreatePicture(ActiveChart.Parent)
        
errHandler:

        .Parent.Delete
    End With
    
    Application.EnableEvents = True
End Sub
    
Private Function CreatePicture(ByVal Chart As ChartObject) As IPicture

    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
    Dim iPic As IPicture, lRet As Long
    
    On Error GoTo errHandler

    Chart.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    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
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, iPic)
    Else
        lRet = OleCreatePictureIndirectPro(uPicinfo, IID_IDispatch, True, iPic)
    End If
    FreeLibrary hLib
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
errHandler:
    EmptyClipboard
    CloseClipboard
End Function

Private Sub oWs_Change(ByVal Target As Range)
    If Not Intersect(Target, oChartSourceRange) Is Nothing Then
        Call Execute
    End If
End Sub

2- Code UserForm With MultiPage:
Code: 
Option Explicit

Private oChart1 As CUserFormChart
Private oChart2 As CUserFormChart

Private Sub UserForm_Initialize()

    Set oChart1 = New CUserFormChart
    Set oChart2 = New CUserFormChart

    With Me.MultiPage1
        .Pages(0).Caption = "Chart 1"
        .Pages(1).Caption = "Chart 2"
        .Value = 0
    End With

    With oChart1
        Set .FrameHost = Me.MultiPage1.Pages(0).Frame1
        Set .SourceRange = Sheet1.Range("A3:D15")
        .ChartType = xlXYScatter
        .ChartTitle = Sheet1.Range("A2").Text
        .ShowHoverToolTip = True
        .Execute
    End With

    With oChart2
        Set .FrameHost = Me.MultiPage1.Pages(1).Frame2
        Set .SourceRange = Sheet1.Range("A19:D31")
        .ChartType = xlXYScatterSmooth
        .ChartTitle = Sheet1.Range("A18").Text
        .ShowHoverToolTip = True
        .Execute
    End With

End Sub

3-Code In Simple UserForm :
Code: 
Option Explicit

Private oChart1 As CUserFormChart
Private oChart2 As CUserFormChart

Private Sub UserForm_Initialize()

    Set oChart1 = New CUserFormChart
    Set oChart2 = New CUserFormChart

    With oChart1
        Set .FrameHost = Me.Frame1
        Set .SourceRange = Sheet1.Range("A3:D15")
        .ChartType = xlXYScatter
        .ChartTitle = Sheet1.Range("A2").Text
        .ShowHoverToolTip = True
        .Execute
    End With

    With oChart2
        Set .FrameHost = Me.Frame2
        Set .SourceRange = Sheet1.Range("A19:D31")
        .ChartType = xlRadarMarkers
        .ChartTitle = Sheet1.Range("A18").Text
        .ShowHoverToolTip = True
        .Execute
    End With

End Sub
 
Last edited:
Upvote 0
Thanks Jaafar for your time and efforts. My 32 bit 2016 installation doesn't seem to work... no hovering. This part of the code wouldn't compile with the extra end if or maybe I commented out the wrong one? Dave
Rich (BB code): 
Private Sub Frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Static bTipShowing As Boolean
    Dim p As POINTAPI, i As Long

    If bShowHoverToolTip Then
    
        p.X = X: p.Y = Y
        For i = 0 To UBound(arrMarkersRects)
        
        #If  VBA7 Then
            #If  Win64 Then
                Dim lngPtr As LongPtr
                CopyMemory lngPtr, p, LenB(p)
                If PtInRect(arrMarkersRects(i), lngPtr) Then
            #End  If
        #Else 
            If PtInRect(arrMarkersRects(i), X, Y) Then
        #End  If
                If bTipShowing = False Then
                    bTipShowing = True
                    Call ShowToolTip(arrTipTexts(i), X, Y)
                End If
                Exit Sub
            'End If
        Next
        If bTipShowing = True Then
            oLbl.Visible = False
            bTipShowing = False
        End If
    
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Conditional Format Selected Cell
2
Replies
12
Views
169
Pacman52
P
P
  • Question Question
Show Login Form If Workbook In Active
Replies
3
Views
155
Pacman52
P
D
  • Solved
SUM of Columns based on multiple criteria with User Form
2
Replies
15
Views
294
Alex Blakenburg
A
G
  • Question Question
Bug with passing variables between user forms--VBA
Replies
4
Views
473
Domenic
D
T
  • Solved
Modifying a Donut Chart
Replies
3
Views
120
Kaper
Kaper

Forum statistics

Threads
1,223,894
Messages
6,175,250
Members
452,623
Latest member
Techenthusiast

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top