That's brilliant, thank you. Is it possible to alternate the text colour? Green for Input and Red for Copy Mode.
That's brilliant, thank you. Is it possible to alternate the text colour? Green for Input and Red for Copy Mode.
This brings up the prompt but cancel doesn't stop the procedure.
Code:Public Sub ClipClear()
Call ClipOff
MsgBox "Are you sure you wish to clear the data?", vbQuestion + vbYesNo + vbDefaultButton2, "Automatic Clipboard"
Sheet10.Range("$C$4") = Null
End Sub
Okay, this is the solution.
I'd still like the message to show as green or red as described previously.Code: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,C8,C9,C10,C11,C13,C16,C19,E13,G13,I13,E16,G16,I16").ClearContents
Sheet10.Range("E7:I7").ClearContents
Sheet10.Range("E10:I10").ClearContents
Sheet10.Range("E19:I19").ClearContents
Sheet10.Range("C22:I22").ClearContents
Sheet10.Range("$C$4") = Null
Else
'Do nothing
End If
End Sub
I think I have figured it out, is this how you would do it?
Code: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 = vbRed
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbRed
.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 = RGB(146, 208, 80)
.Shapes("Button 33").TextFrame.Characters.Font.Color = vbBlack
.IsClipRunning = False
.Protect
End With
End Sub
I'm trying to change the background colour but cannot get the syntax correct.
How do I define the background colour of this textframe please?Code:.Shapes("Status").TextFrame.Fill.BackColor.RGB = RGB(146, 208, 80)
here again your workbook.
Thank you very much, you have been so helpful.
Identical functionality:
Code:Buttons(2).Font.Color = 255
Shapes("Button 33").TextFrame.Characters.Font.Color = vbRed
Thanks snb.
@arnelgp
Ah, some functionality is missing and I had assumed it was there before. The idea behind this worksheet is that pressing play not only displays the last cell selected containing data, it also automatically copies it to the Windows clipboard.
Is that an easy feature to add now that we have start/stop functionality? If so, what additional code is required/where please?
Is this the best way?
Modify the putToClipboard code:
Code:Public Function putToClipboard(ByVal theValue As Variant)
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText theValue
Sheet10.Range("$C$4") = theValue
End With
Sheet10.Range("$C$4").Copy
End Function
forgot to PutInClipboard:
Code: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
I have just tried using another workbook open at the same time and it's producing errors:
http://www.vbaexpress.com/forum/imag...BJRU5ErkJggg==
How can this be resolved?Code:Private WithEvents oCbarEvents As CommandBars
Ah, the error message image didn't attach.
Attachment 30122
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:
My workbooks contain a lot of these types of events so I need to know how to avoid this error and have everything continue to work normally.Code: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
You'd better use a Userform.Code:Private Sub Worksheet_Change(ByVal Target As Range)
If target.address & target ="$C$4" Then
Application.EnableEvents = False
target = "Choose"
Application.EnableEvents = True
End If
End Sub
This is rapidly becoming a rather complex issue. Normally a thread composes a singular question. Msxl from here on in, single questions only otherwise start a new thread.
Okay, let's try again. I'm occasionally getting an error with the following:
In Sub ProcessTab, it's specifically this code that throws the error:Code: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
Run-time error '13': Type mismatch
Code:ActiveSheet.Range(arr(i)).Select
Run-time error '9': Subscript out of rangeCode:strAddress = arr(0)
I'm not sure what causes it, except that it's related to pressing TAB.Code:thisAddress = Split(strAddress, ":")(0)
https://drive.google.com/file/d/1yL0...ew?usp=sharing
http://www.vbaexpress.com/forum/show...l=1#post416601
I've been testing and come across a problem with text being copied to the clipboard being unreadable
Here is the output in Notepad++
Attachment 30151
In Notepad it shows nothing.
I don't understand. So, I went back to the version that you shared and it's doing the same thing as the Notepad++ screenshot.
Does this happen for anyone else who tries the quoted download? What could be the cause?