Compile Error Private WithEvents oCbarEvents As CommandBars and Private Sub Worksheet

**MSXL** · 09-05-2022, 11:30 AM

Originally Posted by snb

Why do you introduce

Private WithEvents oCbarEvents As CommandBars

in a normal module ?
Who told you this ?

arnelgp in the other thread.

To confirm, this is the complete code so you can see:

ThisWorkbook:

Option Explicit


Private WithEvents oCbarEvents As CommandBars


#If VBA7 Then
    Private Declare PtrSafe Function GetClipboardSequenceNumber Lib "User32" () As Long
#Else
    Private Declare Function GetClipboardSequenceNumber Lib "User32" () As Long
#End If


Private Const TARGET_SHEET As String = "Clipboard"
Private Const TARGET_RANGE As String = "C7,C8,C9,C10,C11,C13,E7,E10,E13,G13,I13,E16,G16,I16,C16,C19,E19,C22" 'Set tab order
Private Const TARGET_INFO_RANGE As String = "C4"


Private Sub Workbook_Open()
'    Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
    Call ClipOff
    'arnelgp
    'intialize the array
    Sheets("Clipboard").Range("A1").Select
    Clipboard.strAddress = "$C$7"
    Sheets("Clipboard").Select
    Range(Clipboard.strAddress).Select
    
    With Sheet10
        .Unprotect
        .Shapes("Status").TextFrame.Characters.Text = "Input Mode"
        .Protect
    End With
    
    Application.EnableEvents = True
    Application.OnKey "{TAB}", "Clipboard.ProcessTab"
    Application.OnKey "+{TAB}", "Clipboard.ProcessBkTab"
    'Cells included in array
    Clipboard.arr = Array("$C$7", "$C$8", "$C$9", "$C$10", "$C$11", "$C$13", "$E$7", "$E$10", "$E$13", "$G$13", "$I$13", "$E$16", "$G$16", "$I$16", "$C$16", "$C$19", "$E$19", "$C$22")
    
    Set oCbarEvents = Application.CommandBars
Application.EnableEvents = False
    Dim Sh As Worksheet
    For Each Sh In Worksheets
        If Sh.Name = "Property Numbering" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C14,C8").ClearContents
            Sh.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
            Sh.Range("C14,C8").Value = "'Choose"
        ElseIf Sh.Name = "VO Areas" Then
            Sh.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            Sh.Range("C4").ClearContents
            Sh.Range("C4").Value = "'Choose"
        Else
            Sh.Protect UserInterFaceOnly:=True
        End If
    Next
Application.EnableEvents = True
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set oCbarEvents = Application.CommandBars
End Sub


Private Sub oCbarEvents_OnUpdate()


    Static lPrevSN As Long
   
    Dim MyDataObject As Object
    Dim lCutCopy As Long
    Dim sClipText As String
   
    If GetClipboardSequenceNumber <> lPrevSN Then
        If Application.CutCopyMode <> False Then
            With Sheets(TARGET_SHEET)
                lCutCopy = Application.CutCopyMode
                If Not Intersect(ActiveWindow.RangeSelection, .Range(TARGET_RANGE)) Is Nothing Then
                    Set MyDataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    MyDataObject.GetFromClipboard
                    sClipText = MyDataObject.GetText(1)
                    Mid(sClipText, Len(sClipText), 1) = vbNullChar
                    If InStr(sClipText, Chr(&HA)) Then
                        sClipText = Replace(sClipText, Chr(&H22), "")
                    End If
                    If .ProtectContents Then
                     .Unprotect
                    .Range(TARGET_INFO_RANGE) = sClipText
                    .Protect
                   End If
                    Set oCbarEvents = Nothing
                    If lCutCopy = 1 Then
                        ActiveWindow.RangeSelection.Copy
                    Else
                        ActiveWindow.RangeSelection.Cut
                    End If
                    Set oCbarEvents = Application.CommandBars
                End If
            End With
        End If
    End If
    lPrevSN = GetClipboardSequenceNumber
End Sub

Worksheet: Clipboard

Option Explicit


Public IsClipRunning As Boolean


Private Sub Worksheet_Activate()
    With Worksheets("Clipboard")
         .Range("C7").Select
        strAddress = .ActiveCell.Address
'    MsgBox "Software relies heavily on the Windows clipboard." & Chr(13) & Chr(13) & "If you need to duplicate information to multiple accounts/properties, use this tool." & Chr(13) & Chr(13) & "Type the information needed, press ""Enter"" and then any cell you click on will automatically be copied to the clipboard.", vbInformation + vbOKOnly, "Automatic Clipboard"
    End With
    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = True
    End With
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
        .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    Dim thisAddress As String
    thisAddress = Split(Target.Address, ":")(0)
    Clipboard.strAddress = Target.Address
    If IsClipRunning Then
        If Len(Trim$(Sheet10.Range(thisAddress).Value & "")) Then
            putToClipboard Sheet10.Range(thisAddress).Value
        End If
    End If
End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    MsgBox ("To paste data, press ""Ctrl"" & ""V""."), _
    vbInformation, "Automatic Clipboard"
End Sub


Sub PasteasValue()
Selection.PasteSpecial Paste:=xlPasteValues
End Sub

Clipboard Module:

Option Explicit


Public arr As Variant
Public strAddress As String


Public Sub ProcessTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
    For i = 0 To UBound(arr)
        If arr(i) = Split(strAddress, ":")(0) Then
            If i = UBound(arr) Then
                i = 0
            Else
                i = i + 1
            End If
            Exit For
        End If
    Next
    ActiveSheet.Range(arr(i)).Select
Else
    strAddress = arr(0)
End If
End Sub


Public Sub ProcessBkTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
    For i = 0 To UBound(arr)
        If arr(i) = Split(strAddress, ":")(0) Then
            If i = 0 Then
                i = UBound(arr)
            Else
                i = i - 1
            End If
            Exit For
        End If
    Next
    ActiveSheet.Range(arr(i)).Select
Else
    strAddress = arr(0)
End If
End Sub


Public Function putToClipboard(ByVal theValue As Variant)
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText theValue & ""
        .PutInClipboard
    End With
    Sheet10.Range("$C$4") = theValue
End Function


Public Sub ClipOn()
Dim thisAddress As String
thisAddress = Split(strAddress, ":")(0)
With Sheet10
    .IsClipRunning = True
    ' unprotect and change the color of the "play" button to red (or you may use any color)
    .Unprotect
    .Shapes("Status").TextFrame.Characters.Text = "Copy Mode"
    .Shapes("Status").TextFrame.Characters.Font.Color = vbWhite
    .Shapes("Status").Fill.ForeColor.RGB = vbRed
    .Shapes("Button 33").TextFrame.Characters.Font.Color = vbRed
    .Shapes("Button 34").TextFrame.Characters.Font.Color = vbBlack
    Sheet10.Range("C7,C8,C9,C10,C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16,I16").Interior.Color = RGB(242, 242, 242)
    Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = RGB(128, 134, 146)
    .Protect
    If Len(Trim$(.Range(thisAddress).Value & "")) Then
        Call putToClipboard(.Range(thisAddress).Value)
    End If
End With
End Sub


Public Sub ClipOff()
With Sheet10
    ' unprotect to re-instate the color of "play" button to black
    .Unprotect
    .Shapes("Status").TextFrame.Characters.Text = "Input Mode"
    .Shapes("Status").TextFrame.Characters.Font.Color = vbBlack
    .Shapes("Status").Fill.ForeColor.RGB = RGB(146, 208, 80)
    .Shapes("Button 33").TextFrame.Characters.Font.Color = vbBlack
    .Shapes("Button 34").TextFrame.Characters.Font.Color = RGB(146, 208, 80)
    .IsClipRunning = False
    .Protect
End With
End Sub


Public Sub ClipClear()
Dim Answer As Integer
Answer = MsgBox("Are you sure you wish to clear the data?", vbQuestion + vbYesNo + vbDefaultButton2, "Automatic Clipboard")
If Answer = vbYes Then
    Call ClipOff
    Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,I13,E16,G16,I16,E19:I19").ClearContents
    Sheet10.Range("C7:C11,C13,C16,C19,C22,E7:I7,E10:I10,E13,I13,E16,E19:I19,G13,G16,I16").Interior.Color = RGB(146, 208, 80)
    Sheet10.Range("C6:C11,C12:C13,C15:C16,C18:C19,E6:I7,E9:I10,E12:E13,E15:E16,G12:G13,G15:G16,I12:I13,I15:I16,E18:I19,C21:I22").Font.Color = vbBlack
Weight:=xlMedium, Color:=vbBlack
    Sheet10.Range("A1").Select
    Sheet10.Range("C7").Select
    Sheet10.Range("$C$4") = Null
Else
    'Do nothing
End If
End Sub


Sub Help_Click()
    Dim Help As Integer
    Help = MsgBox("Software relies heavily on the Windows clipboard." & Chr(13) & Chr(13) & _
    "If you need to duplicate information to multiple accounts/properties, use this tool." & Chr(13) & Chr(13) & _
    "Type the information you need to copy, then within ""Clipboard Controls"" click """ & Chr(62) & """ and then any cell you click on will automatically be copied to the clipboard." & Chr(13) & Chr(13) & _
    "To input text, click ""||"" and when finished, click """ & Chr(62) & """ to continue copying.", _
    vbOKOnly + vbInformation, "About Automatic Clipboard")
        If Help = vbOK Then
    End If
End Sub

Thread: Compile Error Private WithEvents oCbarEvents As CommandBars and Private Sub Worksheet

Thread Tools

Display

Threaded View

Posting Permissions