Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ' Leave some lines free above
- ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242918
- Sub WotchaGotInHorizontalClit() 'Examine what is copied to clipboard from a row, and paste it into code module
- Rem 0 Test range
- Range("A1:C1").Value = Array("A1", "B1", "C1")
- Rem 1 Clitbored
- Range("A1:C1").Copy
- Dim objDataObject As Object ' DataObject Late Binding equivalent ' http://excelmatters.com/2013/09/23/vba-references-and-early-binding-vs-late-binding/ http://www.excelfox.com/forum/showthread.php/2240-VBA-referring-to-external-shared-Libraries-1)-Early-1-5)-Laterly-Early-and-2)-Late-Binding-Techniques
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
- objDataObject.GetFromClipboard
- Dim strIn As String: Let strIn = objDataObject.GetText() 'String of range as held in clitbored
- Rem 2 examine string from clitbored
- Dim myLenf As Long: Let myLenf = Len(strIn)
- Dim cnt As Long
- For cnt = 1 To myLenf
- Dim Caracter As Variant ' String
- Let Caracter = Mid(strIn, cnt, 1)
- Dim WotchaGot As String
- If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then ' Check for normal characters
- Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
- Else
- Select Case Caracter
- Case " "
- Let WotchaGot = WotchaGot & """" & " " & """" & " & "
- Case vbCr
- Let WotchaGot = WotchaGot & "vbCr & "
- Case vbLf
- Let WotchaGot = WotchaGot & "vbLf & "
- Case vbCrLf
- Let WotchaGot = WotchaGot & "vbCrLf & "
- Case """"
- Let WotchaGot = WotchaGot & """" & """" & """" & " & "
- Case vbTab
- Let WotchaGot = WotchaGot & "vbTab & "
- Case Else
- WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
- 'Let CaseElse = Caracter
- End Select
- End If
- Next cnt
- If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "
- MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
- Rem 4 paste into code module
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem " & strIn ' a Rem is added to stop the code module showing red error
- Set objDataObject = Nothing
- End Sub
- '
- Sub WotchaGotInCodeWindowHorizontal() ' Examine first line of text in the code module
- Rem 1 Put first line from code module into a string
- Dim strVonCodMod As String
- Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=1)
- Let strVonCodMod = Replace(strVonCodMod, "Rem ", "", 1, -1, vbBinaryCompare)
- Rem 2 examine string from code module line 1
- Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
- Dim cnt As Long
- For cnt = 1 To myLenf
- Dim Caracter As Variant ' String
- Let Caracter = Mid(strVonCodMod, cnt, 1)
- Dim WotchaGot As String
- If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
- Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
- Else
- Select Case Caracter
- Case " "
- Let WotchaGot = WotchaGot & """" & " " & """" & " & "
- Case vbCr
- Let WotchaGot = WotchaGot & "vbCr & "
- Case vbLf
- Let WotchaGot = WotchaGot & "vbLf & "
- Case vbCrLf
- Let WotchaGot = WotchaGot & "vbCrLf & "
- Case """"
- Let WotchaGot = WotchaGot & """" & """" & """" & " & "
- Case vbTab
- Let WotchaGot = WotchaGot & "vbTab & "
- Case Else
- WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
- 'Let CaseElse = Caracter
- End Select
- End If
- Next cnt
- If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
- MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
- Rem 3 clipbored
- '3a Put string from first code module line in clipbored
- Dim objDataObject As Object '
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- objDataObject.SetText strVonCodMod
- objDataObject.PutInClipboard
- Set objDataObject = Nothing
- '3b paste string from first code module line into worksheet
- Range("A1:C1").ClearContents
- Paste Destination:=Range("A1")
- Rem 4 Delete first line from code module
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=1
- End Sub
- '
- Sub WotchaGotInVirticalClit() ''Examine what is copied to clipboard from a column, and paste it into code module
- Rem 0 Test range
- Dim WhoRay(1 To 3, 1 To 1) As String: Let WhoRay(1, 1) = "A1": Let WhoRay(2, 1) = "A2": Let WhoRay(3, 1) = "A3"
- Let Range("A1:A3").Value = WhoRay
- Rem 1 Clipboard
- Range("A1:A3").Copy
- Dim objDataObject As Object
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- objDataObject.GetFromClipboard
- Dim strIn As String: Let strIn = objDataObject.GetText()
- Rem 2 Examine string held in clipboard from a copy from a column
- Dim myLenf As Long: Let myLenf = Len(strIn)
- Dim cnt As Long
- For cnt = 1 To myLenf
- Dim Caracter As Variant ' String
- Let Caracter = Mid(strIn, cnt, 1)
- Dim WotchaGot As String
- If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
- Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
- Else
- Select Case Caracter
- Case " "
- Let WotchaGot = WotchaGot & """" & " " & """" & " & "
- Case vbCr
- Let WotchaGot = WotchaGot & "vbCr & "
- Case vbLf
- Let WotchaGot = WotchaGot & "vbLf & "
- Case vbCrLf
- Let WotchaGot = WotchaGot & "vbCrLf & "
- Case """"
- Let WotchaGot = WotchaGot & """" & """" & """" & " & "
- Case vbTab
- Let WotchaGot = WotchaGot & "vbTab & "
- Case Else
- WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
- End Select
- End If
- Next cnt
- If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
- MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
- Rem 4 Paste stringt from clipboard into top of code module
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem " & Replace(strIn, vbLf, vbLf & "Rem ", 1, 2, vbBinaryCompare)
- Set objDataObject = Nothing
- End Sub
- Sub WotchaGotInCodeWindowVertical() ' Examins what is held in a code module after pasting in a column froma worksheet
- Rem 1 Put first 4 lines from code module into a string
- Dim strVonCodMod As String
- Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=4)
- Let strVonCodMod = Replace(strVonCodMod, "Rem ", "", 1, -1, vbBinaryCompare)
- Rem 2 Examine contents of string
- Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
- Dim cnt As Long
- For cnt = 1 To myLenf
- Dim Caracter As Variant ' String
- Let Caracter = Mid(strVonCodMod, cnt, 1)
- Dim WotchaGot As String
- If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
- Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
- Else
- Select Case Caracter
- Case " "
- Let WotchaGot = WotchaGot & """" & " " & """" & " & "
- Case vbCr
- Let WotchaGot = WotchaGot & "vbCr & "
- Case vbLf
- Let WotchaGot = WotchaGot & "vbLf & "
- Case vbCrLf
- Let WotchaGot = WotchaGot & "vbCrLf & "
- Case """"
- Let WotchaGot = WotchaGot & """" & """" & """" & " & "
- Case vbTab
- Let WotchaGot = WotchaGot & "vbTab & "
- Case Else
- WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
- 'Let CaseElse = Caracter
- End Select
- End If
- Next cnt
- If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
- MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
- Rem 3 Clipboard
- '3a Put string into clipboard
- Dim objDataObject As Object '
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- objDataObject.SetText strVonCodMod
- objDataObject.PutInClipboard
- Set objDataObject = Nothing
- '3b Paste into worksheet from clipboard
- Paste Destination:=Range("A1")
- Rem 4 Delet first 4 rows from code module
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=4
- End Sub
- Sub Pubic_Properly_Let_RngAsString_() ' Examination of a range copied to clipboard, then paste to Private Class code module
- Range("A1:C1").Value = Array("A1", "B1", "C1")
- Range("A2:C2").Value = Array("A2", "B2", "C2")
- Range("A3:C3").Value = Array("A3", "B3", "C3")
- Range("A1:C3").Copy
- Dim objDataObject As Object
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- objDataObject.GetFromClipboard
- Dim strIn As String: Let strIn = objDataObject.GetText()
- Dim myLenf As Long: Let myLenf = Len(strIn)
- Dim cnt As Long
- For cnt = 1 To myLenf
- Dim Caracter As Variant ' String
- Let Caracter = Mid(strIn, cnt, 1)
- Dim WotchaGot As String
- If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
- Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
- Else
- Select Case Caracter
- Case " "
- Let WotchaGot = WotchaGot & """" & " " & """" & " & "
- Case vbCr
- Let WotchaGot = WotchaGot & "vbCr & "
- Case vbLf
- Let WotchaGot = WotchaGot & "vbLf & "
- Case vbCrLf
- Let WotchaGot = WotchaGot & "vbCrLf & "
- Case """"
- Let WotchaGot = WotchaGot & """" & """" & """" & " & "
- Case vbTab
- Let WotchaGot = WotchaGot & "vbTab & "
- Case Else
- WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
- Let CaseElse = Caracter
- End Select
- End If
- Next cnt
- If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
- MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot: Debug.Print
- MsgBox Prompt:=Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print
- MsgBox Prompt:=Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print
- Let strIn = Replace(strIn, vbTab, " | ", 1, -1, vbBinaryCompare) ' replace tab with |
- MsgBox Prompt:=strIn: Debug.Print strIn
- Let strIn = "Rem " & Replace(strIn, vbLf, vbLf & "Rem ", 1, 2, vbBinaryCompare) ' add some Rems to prevent red error in code window
- Debug.Print
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.AddFromString strIn
- Set objDataObject = Nothing
- End Sub
- Sub Fumic_Properly_Get_Rng_AsString() ' Paste rworksheet range stored in code modulle back to worksheet
- Range("A1:C3").ClearContents
- '
- Dim strVonCodMod As String
- Let strVonCodMod = ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.Lines(Startline:=1, Count:=4)
- Let strVonCodMod = Replace(strVonCodMod, "Rem ", "", 1, -1, vbBinaryCompare)
- Let strVonCodMod = Replace(strVonCodMod, " | ", vbTab, 1, -1, vbBinaryCompare)
- Dim objDataObject As Object '
- Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
- objDataObject.SetText strVonCodMod
- objDataObject.PutInClipboard
- Set objDataObject = Nothing
- Paste Destination:=Range("A1")
- On Error Resume Next
- ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.DeleteLines Startline:=1, Count:=4
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement