VBA Ribbon Check Button, Release stored memory

D

decadence

Well-known Member
Joined
Oct 9, 2015
Messages
525
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2010
  5. 2007
Platform
  1. Windows
Hi I have currently adapted a code I got from a website, not sure which however the Issue I'm facing is Excel closes down on too many check button clicks, Is there a way to release the memory to stop this from happening? Code Below

Module Code
VBA Code: 
Option Explicit
#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)
#Else
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)
#End If
Public ChkBx(1 To 8) As Boolean
Public Fnd As String, Rplc As String
Public RefreshRibbon As IRibbonUI

Public Sub RefreshControls(ribbon As IRibbonUI)
'
    Set RefreshRibbon = ribbon ' Set Ribbon onLoad
    saveGlobal RefreshRibbon, "RibbonPtr" 'This Function to Save and ReStore Ribbon after Replacing Below Items or any Fault
    ' Contnue Replacing to save values of Ribbon Controls Using:   Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)'

    ChkBx(1) = False
    ChkBx(2) = False
    ChkBx(3) = False
    ChkBx(4) = False
    ChkBx(5) = False
    ChkBx(6) = False
    ChkBx(7) = False
    ChkBx(8) = False
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub


Public Sub Checkbox_getPressed(control As IRibbonControl, ByRef returnedVal)
'
    ChkBx(1) = False
    ChkBx(2) = False
    ChkBx(3) = False
    ChkBx(4) = False
    ChkBx(5) = False
    ChkBx(6) = False
    ChkBx(7) = False
    ChkBx(8) = False
    Select Case control.ID
        Case "CB1"
            returnedVal = ChkBx(1)
        Case "CB2"
            returnedVal = ChkBx(2)
        Case "CB3"
            returnedVal = ChkBx(3)
        Case "CB4"
            returnedVal = ChkBx(4)
        Case "CB5"
            returnedVal = ChkBx(5)
        Case "CB6"
            returnedVal = ChkBx(6)
        Case "CB7"
            returnedVal = ChkBx(7)
        Case "CB8"
            returnedVal = ChkBx(8)
    End Select
End Sub

Public Sub Checkbox_onAction(control As IRibbonControl, pressed As Boolean)
'
    Fnd = ""
    Rplc = ""
    Select Case control.ID
        Case "CB1"
            If pressed = True Then
                ChkBx(1) = pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed: ChkBx(4) = Not pressed
                ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(1) = " & Not pressed: Rplc = "ChkBx(1) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(1) = pressed
              
                Fnd = "ChkBx(1) = " & Not pressed: Rplc = "ChkBx(1) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB2"
            If pressed = True Then
                ChkBx(2) = pressed: ChkBx(1) = Not pressed: ChkBx(3) = Not pressed: ChkBx(4) = Not pressed
                ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(2) = " & Not pressed: Rplc = "ChkBx(2) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(2) = pressed
              
                Fnd = "ChkBx(2) = " & Not pressed: Rplc = "ChkBx(2) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB3"
            If pressed = True Then
                ChkBx(3) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(4) = Not pressed
                ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(3) = " & Not pressed: Rplc = "ChkBx(3) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(3) = pressed
              
                Fnd = "ChkBx(3) = " & Not pressed: Rplc = "ChkBx(3) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB4"
            If pressed = True Then
                ChkBx(4) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed
                ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(4) = " & Not pressed: Rplc = "ChkBx(4) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(4) = pressed
              
                Fnd = "ChkBx(4) = " & Not pressed: Rplc = "ChkBx(4) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB5"
            If pressed = True Then
                ChkBx(5) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed
                ChkBx(4) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(5) = " & Not pressed: Rplc = "ChkBx(5) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(5) = pressed
              
                Fnd = "ChkBx(5) = " & Not pressed: Rplc = "ChkBx(5) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB6"
            If pressed = True Then
                ChkBx(6) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed
                ChkBx(4) = Not pressed: ChkBx(5) = Not pressed: ChkBx(7) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(6) = " & Not pressed: Rplc = "ChkBx(6) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(6) = pressed
              
                Fnd = "ChkBx(6) = " & Not pressed: Rplc = "ChkBx(6) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
        Case "CB7"
            If pressed = True Then
                ChkBx(7) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed
                ChkBx(4) = Not pressed: ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(8) = Not pressed

                Fnd = "ChkBx(7) = " & Not pressed: Rplc = "ChkBx(7) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(8) = " & pressed: Rplc = "ChkBx(8) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(7) = pressed
              
                Fnd = "ChkBx(7) = " & Not pressed: Rplc = "ChkBx(7) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
          
          
        Case "CB8"
            If pressed = True Then
                ChkBx(8) = pressed: ChkBx(1) = Not pressed: ChkBx(2) = Not pressed: ChkBx(3) = Not pressed
                ChkBx(4) = Not pressed: ChkBx(5) = Not pressed: ChkBx(6) = Not pressed: ChkBx(7) = Not pressed

                Fnd = "ChkBx(8) = " & Not pressed: Rplc = "ChkBx(8) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(1) = " & pressed: Rplc = "ChkBx(1) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(2) = " & pressed: Rplc = "ChkBx(2) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc

                Fnd = "ChkBx(3) = " & pressed: Rplc = "ChkBx(3) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                Fnd = "ChkBx(7) = " & pressed: Rplc = "ChkBx(7) = " & Not pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
              
                ''''''''You Action Here
            ElseIf pressed = False Then
                ChkBx(8) = pressed
              
                Fnd = "ChkBx(8) = " & Not pressed: Rplc = "ChkBx(8) = " & pressed
                VBRplcr "RefreshControls", Fnd, Rplc: VBRplcr "Checkbox_getPressed", Fnd, Rplc
            End If
    End Select
    If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
    RefreshRibbon.Invalidate
End Sub


Public Sub saveGlobal(Glbl As Object, GlblName As String)
'
#If VBA7 Then
    Dim lngRibPtr As LongPtr
#Else
    Dim lngRibPtr As Long
#End If
  
    lngRibPtr = ObjPtr(Glbl)
    With ThisWorkbook
    On Error Resume Next
        .Names(GlblName).Delete
    On Error GoTo 0
        .Names.Add GlblName, lngRibPtr
        .Saved = True
    End With
End Sub

Public Function GetGlobal(GlblName As String) As Object
'
#If VBA7 Then
    Dim xPtr As LongPtr
    xPtr = CLngPtr(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
#Else
    Dim xPtr As Long
    xPtr = CLng(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
#End If

    Dim objRibbon As Object
    CopyMemory objRibbon, xPtr, Len(xPtr)
    Set GetGlobal = objRibbon
End Function

Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)
'Microsoft Visual Basic for Applications Extensibility 5.3 is required
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ThisLine As String
Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, PrcCnountLine As Long, N As Long

    Set VBProj = ThisWorkbook.VBProject
    For Each VBComp In VBProj.VBComponents
        With VBComp
            If .Type = vbext_ct_StdModule Then
                With .CodeModule
                    If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then
                        On Error Resume Next
                        ProcStrLn = .ProcStartLine(PrcName, vbext_pk_Proc)
                        ProcAcStrLn = .ProcBodyLine(PrcName, vbext_pk_Proc)
                        ProcCntLn = .ProcCountLines(PrcName, vbext_pk_Proc)
                        PrcCnountLine = ProcCntLn - (ProcAcStrLn - ProcStrLn)
                        If PrcName = .ProcOfLine(ProcAcStrLn, vbext_pk_Proc) Then
                            For N = (ProcAcStrLn + 1) To (ProcAcStrLn + PrcCnountLine - 1)
                                ThisLine = .Lines(N, 1)
                                If InStr(1, ThisLine, Trim(Fnd), vbTextCompare) > 0 Then
                                    .ReplaceLine N, Replace(ThisLine, Fnd, Rplc, , , vbTextCompare)
                                    Exit For
                                    Exit For
                                    Exit For
                                End If
                            Next N
                        End If
                        Exit Sub
                        Fnd = ""
                        Rplc = ""
                        On Error GoTo 0
                    End If
                End With
            End If
        End With
    Next
End Sub

XML Code
XML: 
<group id="TestTab" label="My Testing Tab">

    <box boxStyle="vertical" id="MyBox1">
        <checkBox id="CB1" label="Box 1" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>                  
        <checkBox id="CB2" label="Box 2" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>                  
        <checkBox id="CB3" label="Box 3" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>
    </box >
    <separator id="ValueSep1" />
    <box boxStyle="vertical" id="MyBox2">
        <checkBox id="CB4" label="Box 4" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>          
        <checkBox id="CB5" label="Box 5" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>                  
        <checkBox id="CB6" label="Box 6" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>
    </box >
    <separator id="ValueSep2" />
    <box boxStyle="vertical" id="MyBox3">
        <checkBox id="CB7" label="Box 7" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>      
        <checkBox id="CB8" label="Box 8" getPressed="Checkbox_getPressed" onAction="Checkbox_onAction"/>
    </box >

</group>
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
You must log in or register to reply here.

Similar threads

C
  • Question Question
Replacing PowerPoint Input using Find and Replace Arrays from Excel through VBA
Replies
0
Views
2K
ckcs
C
M
  • Question Question
I need help with VBA/macro script to collect user input and fill cells
Replies
4
Views
461
mumps
mumps
Agnarr
  • Question Question
VBA problem with creating new sheets
Replies
0
Views
799
Agnarr
Agnarr
C
  • Question Question
search, copy, open Window explorer, paste in the address bar, and open file
Replies
6
Views
492
RoryA
RoryA
D
  • Question Question
Custom Ribbon controls lost Values
Replies
0
Views
590
Dossfm0q
D

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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