View Full Version : [SOLVED:] Compile Error Private WithEvents oCbarEvents As CommandBars and Private Sub Worksheet
I am getting the following error when working on a different workbook, whilst this one is open:
30126
Private WithEvents oCbarEvents As CommandBars
It appears to be something to do with any worksheet containing "Private Sub Worksheet_Change(ByVal Target As Range)" as that's when the error occurs, when switching between sheets in another open workbook.
For example:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C4"), Target) Is Nothing Then
If Range("C4").Value = "" Then
Application.EnableEvents = False
Range("C4").Value = "'Choose"
Application.EnableEvents = True
End If
End If
End Sub
Does anyone know how this can be resolved?
Thanks.
Aussiebear
09-05-2022, 08:10 AM
Sorry but I'm a little old school, and I understand that you new age guys like to shorten your code significantly but....
If you have an "If... then" and you offer an alternative should it not read " If ... then", 'Else", "End If". To me its untidy coding.
Do you mean?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C4"), Target) Is Nothing Then
If Range("C4").Value = "" Then
Application.EnableEvents = False
Else
Range("C4").Value = "'Choose"
Application.EnableEvents = True
End If
End If
End Sub
Is that causing the error?
Why do you introduce
Private WithEvents oCbarEvents As CommandBars
in a normal module ?
Who told you this ?
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
arnelgp
09-05-2022, 07:00 PM
i am sorry MXSL, the code with Commandbar is already there when you uploaded your workbook.
i did not bother to check it since it is not related to Clipboard thing and i made my own Module (Module1).
and just complemented some events that will fill my strAddress variable.
what i will suggest is make a backup of the original workbook and check if Deleting this
code will not affect any previous operations you have.
Thank you for your reply and apologies for getting confused. Removing that code doesn't seem to have caused any issues that I have noticed so far.
ThisWorkbook:
Option Explicit
#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
Clipboard:
Option Explicit
Public IsClipRunning As Boolean
Private Sub Worksheet_Activate()
With Worksheets("Clipboard")
.Range("C7").Select
strAddress = .ActiveCell.Address
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)
Sheet10.Range("C7:C11,C13,C16,C19,C22:I22,E7:I7,E10:I10,E13,G13,I13,E16,G16,I16,E19:I19").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
.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
' MsgBox "Cleared"
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.