Excel VBA - Using same code to apply to multiple textboxes on Userform

K

kazzy

Hi Excel VBA'ers,

Via Google I found some great code (see below) that enables MouseDown
to paste what's in clipboard. I want this code to apply to ALL of the
textboxes in my Userform. Instead of repeating this code multiple
times for every textbox, I was wondering how/if I can specify multiple
textboxes using the one instance of the code please.

(Hmm, if I'm on the right track, perhaps I have to learn about Class
Modules to do this??)

Here is the code that I found:

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
Set doclip = New DataObject
doclip.GetFromClipboard
scode = doclip.GetText
scode = Replace$(scode, Chr$(145), Chr$(39))
scode = Replace$(scode, Chr$(147), Chr$(34))
scode = Replace$(scode, Chr$(148), Chr$(34))
doclip.SetText scode
doclip.PutInClipboard
scode = doclip.GetText
TextBox1 = scode
End Sub
 
J

Jim Cone

Couple of alternatives, depending on exactly what you are after:

There is a userform mouse_down event and the x and y values give you
the position of the cursor on the userform. Run this and see what happens...
'---
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "Button = " & Button & Chr$(13) & _
"Shift = " & Shift & Chr$(13) & _
"X = " & X & " Y = " & Y
End Sub
'---

'Or you could just have one DataObject code sub and
'call it from each textbox mouse down event:
'---
'Code similar to this for each textbox...
Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim strReturn As String
Call GetMeTheData(strReturn)
TextBox1.Value = strReturn
End Sub

'Just one instance of this code...
Private Sub GetMeTheData(ByRef sCode As String)
Dim doclip As DataObject
Set doclip = New DataObject
doclip.GetFromClipboard
sCode = doclip.GetText
sCode = Replace$(sCode, Chr$(145), Chr$(39))
sCode = Replace$(sCode, Chr$(147), Chr$(34))
sCode = Replace$(sCode, Chr$(148), Chr$(34))
doclip.SetText sCode
doclip.PutInClipboard
sCode = doclip.GetText
Set doclip = Nothing
End Sub
'---
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(XL Companion add-in: compares, matches, counts, lists, finds, deletes...)





"kazzy" <[email protected]>
wrote in message
news:9ae08d1b-e9b1-4e84-95dc-a53b125ed5f2@q40g2000prh.googlegroups.com...
 
K

kazzy

Couple of alternatives, depending on exactly what you are after:

There is a userform mouse_down event and the x and y values give you
the position of the cursor on the userform.  Run this and see what happens...
'---
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "Button = " & Button & Chr$(13) & _
  "Shift = " & Shift & Chr$(13) & _
  "X = " & X & " Y = " & Y
End Sub
'---

'Or you could just have one DataObject code sub and
'call it from each textbox mouse down event:
'---
'Code similar to this for each textbox...
Private Sub TextBox1_MouseDown(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim strReturn As String
 Call GetMeTheData(strReturn)
 TextBox1.Value = strReturn
End Sub

'Just one instance of this code...
Private Sub GetMeTheData(ByRef sCode As String)
 Dim doclip As DataObject
 Set doclip = New DataObject
 doclip.GetFromClipboard
 sCode = doclip.GetText
 sCode = Replace$(sCode, Chr$(145), Chr$(39))
 sCode = Replace$(sCode, Chr$(147), Chr$(34))
 sCode = Replace$(sCode, Chr$(148), Chr$(34))
 doclip.SetText sCode
 doclip.PutInClipboard
 sCode = doclip.GetText
 Set doclip = Nothing
End Sub
'---
Jim Cone
Portland, Oregon USAhttp://www.mediafire.com/PrimitiveSoftware
(XL Companion add-in:  compares, matches, counts, lists, finds, deletes....)

"kazzy" <[email protected]>
wrote in message







- Show quoted text -

Thank you Jim. I'll give the 2nd option a go & let you know.
 
R

Rick Rothstein

I was wondering how/if I can specify multiple
textboxes using the one instance of the code please.

Give the following a try. Copy/Paste the following code into the code window
for the UserForm...

'*************************START USERFORM CODE*************************
Dim TextBoxes() As New Class1

Private Sub UserForm_Initialize()
Dim Counter As Integer, Obj As Control
For Each Obj In Me.Controls
If TypeOf Obj Is MSForms.TextBox Then
Counter = Counter + 1
ReDim Preserve TextBoxes(1 To Counter)
Set TextBoxes(Counter).TextBoxEvents = Obj
End If
Next
Set Obj = Nothing
End Sub
'*************************START USERFORM CODE*************************

Next, add a Class Module to your project (click Insert/Class Module on the
menu bar), then Copy/Paste the following code into the Class Module you just
added...

'*************************START CLASS MODULE CODE*************************
Public WithEvents TextBoxEvents As MSForms.TextBox

Private Sub TextBoxEvents_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim doclip As DataObject, scode As String
Set doclip = New DataObject
doclip.GetFromClipboard
scode = doclip.GetText
scode = Replace$(scode, Chr$(145), Chr$(39))
scode = Replace$(scode, Chr$(147), Chr$(34))
scode = Replace$(scode, Chr$(148), Chr$(34))
doclip.SetText scode
doclip.PutInClipboard
scode = doclip.GetText
UserForm1.ActiveControl.Value = scode
End Sub
'*************************START CLASS MODULE CODE*************************

Note the at code inside the MouseDown event in the Class Module is the code
you posted with a Dim statement added to declare the variables and with the
last line changed to assign the modified text to the active control on the
UserForm (which I assumed still has the default name of UserForm1)... this
active control will be the one you left click in. Every TextBox on the
UserForm will be using this one MouseDown event. If you need to know which
TextBox was clicked into, just ask the ActiveControl property of the
UserForm...

MsgBox "Clicked TextBox name = " & UserForm1.ActiveControl.Name & "."

So give it a try. Copy something to the Clipboard that contains the
characters †“ ‘... here is a sentence you can use...

This is a â€test“ to see what‘s what.

and then click in any TextBox to place the modified text into that TextBox.

Rick Rothstein (MVP - Excel)
 
K

kazzy

Give the following a try. Copy/Paste the following code into the code window
for the UserForm...

'*************************START USERFORM CODE*************************
Dim TextBoxes() As New Class1

Private Sub UserForm_Initialize()
    Dim Counter As Integer, Obj As Control
    For Each Obj In Me.Controls
        If TypeOf Obj Is MSForms.TextBox Then
            Counter = Counter + 1
            ReDim Preserve TextBoxes(1 To Counter)
            Set TextBoxes(Counter).TextBoxEvents = Obj
        End If
    Next
    Set Obj = Nothing
End Sub
'*************************START USERFORM CODE*************************

Next, add a Class Module to your project (click Insert/Class Module on the
menu bar), then Copy/Paste the following code into the Class Module you just
added...

'*************************START CLASS MODULE CODE*************************
Public WithEvents TextBoxEvents As MSForms.TextBox

Private Sub TextBoxEvents_MouseDown(ByVal Button As Integer, _
            ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim doclip As DataObject, scode As String
    Set doclip = New DataObject
    doclip.GetFromClipboard
    scode = doclip.GetText
    scode = Replace$(scode, Chr$(145), Chr$(39))
    scode = Replace$(scode, Chr$(147), Chr$(34))
    scode = Replace$(scode, Chr$(148), Chr$(34))
    doclip.SetText scode
    doclip.PutInClipboard
    scode = doclip.GetText
    UserForm1.ActiveControl.Value = scode
End Sub
'*************************START CLASS MODULE CODE*************************

Note the at code inside the MouseDown event in the Class Module is the code
you posted with a Dim statement added to declare the variables and with the
last line changed to assign the modified text to the active control on the
UserForm (which I assumed still has the default name of UserForm1)... this
active control will be the one you left click in. Every TextBox on the
UserForm will be using this one MouseDown event. If you need to know which
TextBox was clicked into, just ask the ActiveControl property of the
UserForm...

    MsgBox "Clicked TextBox name = " & UserForm1.ActiveControl.Name& "."

So give it a try. Copy something to the Clipboard that contains the
characters ” “ ‘... here is a sentence you can use...

    This is a ”test“ to see what‘s what.

and then click in any TextBox to place the modified text into that TextBox.

Rick Rothstein (MVP - Excel)

Thanks Rick. Ooh a "class module" suggestion..my ..VBA world is
growing ;-)

I will also give your suggestion a go & get back here. It's Saturday
in Oz now so will do this on Monday at work. Hope you both have a g8
weekend.
 
K

kazzy

Thanks Rick. Ooh a "class module" suggestion..my ..VBA world is
growing ;-)

I will also give your suggestion a go & get back here. It's Saturday
in Oz now so will do this on Monday at work. Hope you both have a g8
weekend.- Hide quoted text -

- Show quoted text -

Hi, I have tried all ideas & decided that I would like to use Rick's
suggestion because I have 10 textboxes, therefore it's the least code
required. However, I am experiencing a problem as follows:

- Both left & right mouse clicks pastes in the data. I only want
the right mouse click to paste. I tried researching how to specify
right mouse click only but could not find anything.

If not possible to specify right mouse click only I'll use Jim's
coding.
 
J

Jim Cone

If you run the first piece of test code I provided you will see the "Button" value
displayed when you left and right click on the userform...
'---
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

MsgBox "Button = " & Button & Chr$(13) & _
"Shift = " & Shift & Chr$(13) & _
"X = " & X & " Y = " & Y
End Sub
'---

So, use something like this to wrap around Rick's or my code...
If Button = xlSecondaryButton Then ' 2
'fill text boxes
End If
--
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Extras for Excel add-in: convenience built-in)





"kazzy" <[email protected]>
wrote in message

Hi, I have tried all ideas & decided that I would like to use Rick's
suggestion because I have 10 textboxes, therefore it's the least code
required. However, I am experiencing a problem as follows:

- Both left & right mouse clicks pastes in the data. I only want
the right mouse click to paste. I tried researching how to specify
right mouse click only but could not find anything.

If not possible to specify right mouse click only I'll use Jim's
coding.
 
R

Rick Rothstein

Hi, I have tried all ideas & decided that I would like to use
Rick's suggestion because I have 10 textboxes, therefore
it's the least code required. However, I am experiencing a
problem as follows:

Both left & right mouse clicks pastes in the data. I only
want the right mouse click to paste. I tried researching
how to specify right mouse click only but could not find
anything.

You never told us you only wanted the right button to initiate this. The
simplest fix is to just put this line of code...

If Button <> xlSecondaryButton Then Exit Sub

as the first line of code in the Class Module's MouseDown event
(xlSecondaryButton is a predefined constant in VB for the right mouse
button). Here is the complete Class code if you just want to copy/paste it
over the existing code there...

'************************START CLASS MODULE CODE************************
Public WithEvents TextBoxEvents As msforms.TextBox

Private Sub TextBoxEvents_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim doclip As DataObject, scode As String
If Button <> xlSecondaryButton Then Exit Sub
Set doclip = New DataObject
doclip.GetFromClipboard
scode = doclip.GetText
scode = Replace$(scode, Chr$(145), Chr$(39))
scode = Replace$(scode, Chr$(147), Chr$(34))
scode = Replace$(scode, Chr$(148), Chr$(34))
doclip.SetText scode
doclip.PutInClipboard
scode = doclip.GetText
UserForm1.ActiveControl.Value = scode
End Sub
'*************************END CLASS MODULE CODE*************************

Rick Rothstein (MVP - Excel)
 
K

kazzy

You never told us you only wanted the right button to initiate this. The
simplest fix is to just put this line of code...

If Button <> xlSecondaryButton Then Exit Sub

as the first line of code in the Class Module's MouseDown event
(xlSecondaryButton is a predefined constant in VB for the right mouse
button). Here is the complete Class code if you just want to copy/paste it
over the existing code there...

'************************START CLASS MODULE CODE************************
Public WithEvents TextBoxEvents As msforms.TextBox

Private Sub TextBoxEvents_MouseDown(ByVal Button As Integer, _
            ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim doclip As DataObject, scode As String
    If Button <> xlSecondaryButton Then Exit Sub
    Set doclip = New DataObject
    doclip.GetFromClipboard
    scode = doclip.GetText
    scode = Replace$(scode, Chr$(145), Chr$(39))
    scode = Replace$(scode, Chr$(147), Chr$(34))
    scode = Replace$(scode, Chr$(148), Chr$(34))
    doclip.SetText scode
    doclip.PutInClipboard
    scode = doclip.GetText
    UserForm1.ActiveControl.Value = scode
End Sub
'*************************END CLASS MODULE CODE*************************

Rick Rothstein (MVP - Excel)

You're right, I neglected to say right click only, I'm sorry. Your
code works great, thank you.

I then wanted to use that code on a multipage form. After a run time
err 13 "type mismatch" I learnt that had to specify multipage
activecontrol & just so you know you put me on the right track I did
this which works:

frmDOHVSRTemplate.MultiPage1.Pages(frmDOHVSRTemplate.MultiPage1.Value).ActiveControl.Value
= scode
 
K

kazzy

You're right, I neglected to say right click only, I'm sorry.  Your
code works great, thank you.

I then wanted to use that code on a multipage form. After a run time
err 13 "type mismatch" I learnt that had to specify multipage
activecontrol & just so you know you put me on the right track I did
this which works:

frmDOHVSRTemplate.MultiPage1.Pages(frmDOHVSRTemplate.MultiPage1.Value).Acti­veControl.Value
= scode- Hide quoted text -

- Show quoted text -

Oops....for those learning like me: frmDOHVSRTemplate = Userform1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top