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
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