Advertisement
AlanElston

PubicProperlyLetGet

Dec 9th, 2018
387
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13. ' Leave some lines free above
  14. '  http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p242918
  15.  
  16. Sub WotchaGotInHorizontalClit() 'Examine what is copied to clipboard from a row, and paste it into code module
  17. Rem 0 Test range
  18. Range("A1:C1").Value = Array("A1", "B1", "C1")
  19. Rem 1 Clitbored
  20. Range("A1:C1").Copy
  21. 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
  22. Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
  23. objDataObject.GetFromClipboard
  24. Dim strIn As String: Let strIn = objDataObject.GetText() 'String of range as held in clitbored
  25. Rem 2 examine string from clitbored
  26. Dim myLenf As Long: Let myLenf = Len(strIn)
  27. Dim cnt As Long
  28.     For cnt = 1 To myLenf
  29.     Dim Caracter As Variant ' String
  30.     Let Caracter = Mid(strIn, cnt, 1)
  31.     Dim WotchaGot As String
  32.         If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then ' Check for normal characters
  33.         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
  34.         Else
  35.          Select Case Caracter
  36.           Case " "
  37.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  38.           Case vbCr
  39.            Let WotchaGot = WotchaGot & "vbCr & "
  40.           Case vbLf
  41.            Let WotchaGot = WotchaGot & "vbLf & "
  42.           Case vbCrLf
  43.            Let WotchaGot = WotchaGot & "vbCrLf & "
  44.           Case """"
  45.            Let WotchaGot = WotchaGot & """" & """" & """" & " & "
  46.           Case vbTab
  47.            Let WotchaGot = WotchaGot & "vbTab & "
  48.           Case Else
  49.            WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
  50.            'Let CaseElse = Caracter
  51.         End Select
  52.         End If
  53.     Next cnt
  54.     If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "
  55. MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
  56. Rem 4 paste into code module
  57.  On Error Resume Next
  58.  ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & strIn ' a Rem is added to stop the code module showing red error
  59. Set objDataObject = Nothing
  60. End Sub
  61.  
  62. '
  63. Sub WotchaGotInCodeWindowHorizontal() ' Examine first line of text in the code module
  64. Rem 1 Put first line from code module into a string
  65. Dim strVonCodMod As String
  66.  Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=1)
  67.  Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
  68. Rem 2 examine string from code module line 1
  69. Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
  70. Dim cnt As Long
  71.     For cnt = 1 To myLenf
  72.     Dim Caracter As Variant ' String
  73.     Let Caracter = Mid(strVonCodMod, cnt, 1)
  74.     Dim WotchaGot As String
  75.         If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
  76.          Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
  77.         Else
  78.          Select Case Caracter
  79.           Case " "
  80.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  81.           Case vbCr
  82.            Let WotchaGot = WotchaGot & "vbCr & "
  83.           Case vbLf
  84.            Let WotchaGot = WotchaGot & "vbLf & "
  85.           Case vbCrLf
  86.            Let WotchaGot = WotchaGot & "vbCrLf & "
  87.           Case """"
  88.            Let WotchaGot = WotchaGot & """" & """" & """" & " & "
  89.           Case vbTab
  90.            Let WotchaGot = WotchaGot & "vbTab & "
  91.           Case Else
  92.            WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
  93.            'Let CaseElse = Caracter
  94.         End Select
  95.         End If
  96.     Next cnt
  97.     If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
  98.  MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
  99. Rem 3 clipbored
  100. '3a Put string from first code module line in clipbored
  101. Dim objDataObject As Object '
  102. Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  103.  objDataObject.SetText strVonCodMod
  104.  objDataObject.PutInClipboard
  105.  Set objDataObject = Nothing
  106. '3b paste string from first code module line into worksheet
  107. Range("A1:C1").ClearContents
  108.  Paste Destination:=Range("A1")
  109. Rem 4 Delete first line from code module
  110.  On Error Resume Next
  111.  ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=1
  112. End Sub
  113.  
  114.  
  115. '
  116. Sub WotchaGotInVirticalClit() ''Examine what is copied to clipboard from a column, and paste it into code module
  117. Rem 0 Test range
  118. 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"
  119.  Let Range("A1:A3").Value = WhoRay
  120. Rem 1 Clipboard
  121.  Range("A1:A3").Copy
  122. Dim objDataObject As Object
  123.  Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  124.  objDataObject.GetFromClipboard
  125. Dim strIn As String: Let strIn = objDataObject.GetText()
  126. Rem 2 Examine string held in clipboard from a copy from a column
  127. Dim myLenf As Long: Let myLenf = Len(strIn)
  128. Dim cnt As Long
  129.     For cnt = 1 To myLenf
  130.     Dim Caracter As Variant ' String
  131.     Let Caracter = Mid(strIn, cnt, 1)
  132.     Dim WotchaGot As String
  133.         If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
  134.          Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
  135.         Else
  136.          Select Case Caracter
  137.           Case " "
  138.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  139.           Case vbCr
  140.            Let WotchaGot = WotchaGot & "vbCr & "
  141.           Case vbLf
  142.            Let WotchaGot = WotchaGot & "vbLf & "
  143.           Case vbCrLf
  144.            Let WotchaGot = WotchaGot & "vbCrLf & "
  145.           Case """"
  146.            Let WotchaGot = WotchaGot & """" & """" & """" & " & "
  147.           Case vbTab
  148.            Let WotchaGot = WotchaGot & "vbTab & "
  149.           Case Else
  150.            WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
  151.          End Select
  152.         End If
  153.     Next cnt
  154.     If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
  155.  MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
  156. Rem 4 Paste stringt from clipboard into top of code module
  157.  On Error Resume Next
  158.  ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.AddFromString "Rem    " & Replace(strIn, vbLf, vbLf & "Rem    ", 1, 2, vbBinaryCompare)
  159.  Set objDataObject = Nothing
  160. End Sub
  161.  
  162. Sub WotchaGotInCodeWindowVertical() ' Examins what is held in a code module after pasting in a column froma worksheet
  163. Rem 1 Put first 4 lines from code module into a string
  164. Dim strVonCodMod As String
  165.  Let strVonCodMod = ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.Lines(Startline:=1, Count:=4)
  166.  Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
  167. Rem 2 Examine contents of string
  168. Dim myLenf As Long: Let myLenf = Len(strVonCodMod)
  169. Dim cnt As Long
  170.     For cnt = 1 To myLenf
  171.     Dim Caracter As Variant ' String
  172.     Let Caracter = Mid(strVonCodMod, cnt, 1)
  173.     Dim WotchaGot As String
  174.         If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
  175.          Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
  176.         Else
  177.          Select Case Caracter
  178.           Case " "
  179.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  180.           Case vbCr
  181.            Let WotchaGot = WotchaGot & "vbCr & "
  182.           Case vbLf
  183.            Let WotchaGot = WotchaGot & "vbLf & "
  184.           Case vbCrLf
  185.            Let WotchaGot = WotchaGot & "vbCrLf & "
  186.           Case """"
  187.            Let WotchaGot = WotchaGot & """" & """" & """" & " & "
  188.           Case vbTab
  189.            Let WotchaGot = WotchaGot & "vbTab & "
  190.           Case Else
  191.            WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
  192.            'Let CaseElse = Caracter
  193.         End Select
  194.         End If
  195.     Next cnt
  196.     If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
  197.  MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot
  198. Rem 3 Clipboard
  199. '3a Put string into clipboard
  200. Dim objDataObject As Object '
  201. Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  202.  objDataObject.SetText strVonCodMod
  203.  objDataObject.PutInClipboard
  204.  Set objDataObject = Nothing
  205. '3b Paste into worksheet from clipboard
  206. Paste Destination:=Range("A1")
  207. Rem 4 Delet first 4 rows from code module
  208.  On Error Resume Next
  209.  ThisWorkbook.VBProject.VBComponents(Me.CodeName).CodeModule.DeleteLines Startline:=1, Count:=4
  210. End Sub
  211.  
  212.  
  213.  
  214. Sub Pubic_Properly_Let_RngAsString_() ' Examination of a range  copied to clipboard, then paste to Private Class code module
  215. Range("A1:C1").Value = Array("A1", "B1", "C1")
  216.  Range("A2:C2").Value = Array("A2", "B2", "C2")
  217.  Range("A3:C3").Value = Array("A3", "B3", "C3")
  218.  Range("A1:C3").Copy
  219. Dim objDataObject As Object
  220.  Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  221.  objDataObject.GetFromClipboard
  222. Dim strIn As String: Let strIn = objDataObject.GetText()
  223. Dim myLenf As Long: Let myLenf = Len(strIn)
  224. Dim cnt As Long
  225.     For cnt = 1 To myLenf
  226.     Dim Caracter As Variant ' String
  227.     Let Caracter = Mid(strIn, cnt, 1)
  228.     Dim WotchaGot As String
  229.         If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Then
  230.          Let WotchaGot = WotchaGot & """" & Caracter & """" & " & "
  231.         Else
  232.          Select Case Caracter
  233.           Case " "
  234.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  235.           Case vbCr
  236.            Let WotchaGot = WotchaGot & "vbCr & "
  237.           Case vbLf
  238.            Let WotchaGot = WotchaGot & "vbLf & "
  239.           Case vbCrLf
  240.            Let WotchaGot = WotchaGot & "vbCrLf & "
  241.           Case """"
  242.            Let WotchaGot = WotchaGot & """" & """" & """" & " & "
  243.           Case vbTab
  244.            Let WotchaGot = WotchaGot & "vbTab & "
  245.           Case Else
  246.            WotchaGot = WotchaGot & """" & "SomeFink" & """" & " & "
  247.            Let CaseElse = Caracter
  248.          End Select
  249.         End If
  250.     Next cnt
  251.     If WotchaGot <> "" Then Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3)
  252.  MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot: Debug.Print
  253.  MsgBox Prompt:=Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbLf & ", "vbLf" & vbCrLf, 1, -1, vbBinaryCompare): Debug.Print
  254.  MsgBox Prompt:=Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print Replace(WotchaGot, "vbTab", """ | """, 1, -1, vbBinaryCompare): Debug.Print
  255.  
  256.  Let strIn = Replace(strIn, vbTab, " | ", 1, -1, vbBinaryCompare) ' replace tab with  |
  257. MsgBox Prompt:=strIn: Debug.Print strIn
  258.  
  259.  Let strIn = "Rem    " & Replace(strIn, vbLf, vbLf & "Rem    ", 1, 2, vbBinaryCompare) ' add some Rems to prevent red error in code window
  260. Debug.Print
  261.  On Error Resume Next
  262.  ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.AddFromString strIn
  263.  Set objDataObject = Nothing
  264. End Sub
  265.  
  266. Sub Fumic_Properly_Get_Rng_AsString() ' Paste rworksheet range stored in code modulle back to worksheet
  267. Range("A1:C3").ClearContents
  268. '
  269. Dim strVonCodMod As String
  270.  Let strVonCodMod = ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.Lines(Startline:=1, Count:=4)
  271.  Let strVonCodMod = Replace(strVonCodMod, "Rem    ", "", 1, -1, vbBinaryCompare)
  272.  Let strVonCodMod = Replace(strVonCodMod, " | ", vbTab, 1, -1, vbBinaryCompare)
  273. Dim objDataObject As Object '
  274. Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  275.  objDataObject.SetText strVonCodMod
  276.  objDataObject.PutInClipboard
  277.  Set objDataObject = Nothing
  278.  Paste Destination:=Range("A1")
  279.  On Error Resume Next
  280.  ThisWorkbook.VBProject.VBComponents("Tabelle1").CodeModule.DeleteLines Startline:=1, Count:=4
  281. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement