Can I run a macro after i've pasted?

[tonywatsonhelp]

Hi Everyone

I'm having a few problems with people wanting to copy data from word and paste into a single cell in excel as excel wont do this the way they want to so i've created a textbox for them to paste into.

but what i need is for a macro called "Tide_up" to run after they have pasted

is it posible to have a macro run after the paste has happened? i cant use active x textbox as you cant right click paste into it.

any ideas would be helpfull.

Thanks

Tony

 

[SQUIDD]

how about on textbox lose focus

Private Sub TextBox1_LostFocus()
tide_up
End Sub

dave

 

[SQUIDD]

sorry

do you mean you have a userform with a textbox?

if so, is it not an option to have a command button?

or use on exit

Call tide_up

Dave

 

[tonywatsonhelp]

Hi Guys,
thanks for your reply,
The textbox is in an excel sheet called "Data1" it is placed in range(G11:I11) and this area is large so you can paste a lot of text into the text box.
the textbox is just a normal shape textbox not active x so there are no lose focus options. I tried using an active x textbox and could do what i wanted but got complaints as you can't right click and paste into the text box only paste using Ctrl V but many or the people using the document are not willing to learn how to do this and want to be able to do it with the right click paste so i had to use a standard textbox.

please help if you can

Thanks

Tony

 

[SQUIDD]

Hi Tony

Im sorry, im not sure on this one, i think if it was me, i would have used an active X textbox, like you was, but had a command button that simply pasted the copied data into it. no right click, just click the command button to paste.

Is this not an option?

assume you cannot simply use a merged cell and use text wrap, because then you could make it look for a cell update on the sheet code.

Dave

 

[tonywatsonhelp]

Hi Squido,
currently i have a cell above the textbox that says "Click here after pasting" and when they click on it it runs the macro but the people use this document are not very flexible and like to do things "their way" so they dont always click on the cell or understand what to do so i'm trying to make it as simple as possible.

I was hoping there was some comand i could use that says something like "after pasting" or a way to trigger a makro from the paste comand.

 

[Jaafar Tribak]

i cant use active x textbox as you cant right click paste into it.

You could use a multiline ActiveX Textbox and create a right-clcik menu on the fly

Place the following code in the Worksheet module where the ActiveX TextBox1 is located:

Option Explicit

Private bMenuOn As Boolean

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If bMenuOn = False Then
        If Button = 2 Then
            bMenuOn = True
             TextBox1.MultiLine = True
            Call CreateRghtClickMenu
           TextBox1.SelStart = Len(TextBox1.Text) + 1
            CommandBars("PasteMenu").ShowPopup
            bMenuOn = False
            Call DeleteRghtClickMenu
        End If
    End If

End Sub


Private Sub PasteMacro()
    Me.TextBox1.Paste
End Sub



Private Sub CreateRghtClickMenu()

    Dim objCmb As CommandBar
    
    Call DeleteRghtClickMenu
    Set objCmb = Application.CommandBars.Add _
    (Position:=msoBarPopup, Temporary:=True)
    With objCmb
        objCmb.Name = "PasteMenu"
        With .Controls.Add(msoControlButton)
            .Caption = "Paste"
            .FaceId = 22
            .OnAction = Me.CodeName & ".PasteMacro"
        End With
    End With
    
End Sub


Private Sub DeleteRghtClickMenu()
    On Error Resume Next
    CommandBars("PasteMenu").Delete
End Sub

 

[tonywatsonhelp]

OMG, Jaafar this is amazing,
does exactly what i need without any editing, thank you so much

Tony

 

[tonywatsonhelp]

Just one problem,
if i add another text box it only works on textbox1 can it be edited to work on any textbox in the sheet or a set number of textboxes?

Thanks

Tony

 

[Jaafar Tribak]

Just one problem,
if i add another text box it only works on textbox1 can it be edited to work on any textbox in the sheet or a set number of textboxes?

Either you add a class module to hook all the instances of textboxes or a better approach, in my opinion, is to use the following non-class module method which won't stop working if variables are accidently released in the vba project.

You will just need to add a MouseUp event one for each TextBox all in the same fashion- Each time passing the respective TextBox name (see code in red)


Same as before, code goes in the worksheet module where the textboxes reside.

Option Explicit


Private Sub [COLOR=#ff0000][B]TextBox1[/B][/COLOR]_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call ShowMenu([COLOR=#ff0000][B]TextBox1[/B][/COLOR], Button, Shift, X, Y)
End Sub

Private Sub [COLOR=#ff0000][B]TextBox2[/B][/COLOR]_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call ShowMenu([COLOR=#ff0000][B]TextBox2[/B][/COLOR], Button, Shift, X, Y)
End Sub

Private Sub [COLOR=#ff0000][B]TextBox3[/B][/COLOR]_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call ShowMenu([COLOR=#ff0000][B]TextBox3[/B][/COLOR], Button, Shift, X, Y)
End Sub


[COLOR=#008000][B]' Add here 'MouseUp' event for the rest of textboxes in the same fashion as above[/B][/COLOR]



[B][COLOR=#008000]'-------------------------------------------------------------------------------------------------------------[/COLOR][/B]
[B][COLOR=#008000]'                             Code below is shared by all TextBoxes.
[/COLOR][/B]
Private Sub ShowMenu(ByVal TextBox As Object, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Dim oDataObj As New DataObject, sClipText As String

    If TextBox.MultiLine = False Then TextBox.MultiLine = True
    
    If Button = 2 Then
        Call oDataObj.GetFromClipboard
        On Error Resume Next
            sClipText = oDataObj.GetText(1)
        On Error GoTo 0
        If Len(sClipText) Then
            TextBox.SelStart = Len(TextBox.Text) + 1
            Call CreateRghtClickMenu(TextBox, True)
        Else
            Call CreateRghtClickMenu(TextBox, False)
        End If
        Call CommandBars("PasteMenu").ShowPopup
        Call DeleteRghtClickMenu
    End If

End Sub


Private Sub PasteMacro(ByVal TextBoxName As String)
   Me.OLEObjects(TextBoxName).Object.Paste
End Sub


Private Sub CreateRghtClickMenu(ByVal TextBox As Object, ByVal Enabled As Boolean)

    Dim objCmb As CommandBar

    Call DeleteRghtClickMenu
    Set objCmb = Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
    With objCmb
        objCmb.Name = "PasteMenu"
        With .Controls.Add(msoControlButton)
            .Caption = IIf(Enabled, "Paste", "ClipBoard Empty !")
            .FaceId = 22
            .Enabled = Enabled
            .OnAction = "'" & Me.CodeName & ".PasteMacro """ & TextBox.Name & "'"
        End With
    End With

End Sub


Private Sub DeleteRghtClickMenu()
    On Error Resume Next
    CommandBars("PasteMenu").Delete
End Sub