Appendix Thread 2. ( Codes for other Threads, HTML Tables, etc.)

[DocAElstein]

Continued from above....

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" & """" & " & "
         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

_.________________________________________________ ______________
Extra Codes For Yassers Normal Excel File, "NormalExcelFile.xlsm" : http://eileenslounge.com/viewtopic.p...=31395#p242964

Option Explicit
Private Sub Publics_Probably_Let_RngAsString__() ' Input of range to Private Properties storage
Rem 0 test data range is selection. Select a range before running this code
Dim rngSel As Range: Set rngSel = Selection ' selected range for later reference
Rem 1 Copy range to clipbored
 rngSel.Copy
Rem 2 put data currently in clipboard into a string
Dim objDataObject As Object ' DataObject  ' This will be for an an Object from the class MS Forms. This will be a Data Object of what we "send" to the Clipboard. But it is a DataObject. It has the Methods I need to send to and get text to the Clipboard. ' 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 ' The data object has the long text string from the clipboard at this point
 'rngSel.ClearContents ' we can't do this here, not sure why??
Dim strIn As String: Let strIn = objDataObject.GetText() ' The string variable, strIn, is given the long string
 rngSel.ClearContents ' do this now. (If we did it before, the contents of the clipboard are typically emptied, so that would be poo. I don't know why the clipboard needs to be full still fir the last code line??
Rem 3 manipulate string to substitute vbTab with arbritrary character combination - in next code this will be replaced. We do this because the vbTab is lost when pasting into a code module
 Let strIn = Replace(strIn, vbTab, " | ", 1, -1, vbBinaryCompare) ' replacing( in the string , replace vbTab  , with " | " , start at first position ,  replace all occurances , look for an excact case sensitive match as this is qiucker if we don't need to be case insensitive as with option vbTextCompare )
 Let strIn = "'_-" & Replace(strIn, vbLf, vbLf & "'_-", 1, -1, vbBinaryCompare) ' add some comment bits to prevent red error in code window
Rem 4 add range data
 Let strIn = "'_-Worksheets(""" & rngSel.Parent.Name & """).Range(""" & rngSel.Address & """)" & vbCrLf & strIn ' Add an extra first header line to indicate the worksheet and range used
 On Error Resume Next ' I am not quite sure why this is needed
 ThisWorkbook.VBProject.VBComponents("YassersDump").CodeModule.AddFromString strIn ' As far as i know, this adds from the start of the module.
 Set objDataObject = Nothing ' This probably is not needed.                                                      It upsets Kyle when i do it, but he can take it :-)
End Sub

Private Sub Publics_Probably_Get_Rng__AsString() ' Output of range from Private Properties Storage
Rem 2 get string data form code module Private properties storage
Dim strVonCodMod As String
'2a Range infomation first line
Dim Ws As Worksheet, Rng As Range ' These will be used for the range identification infomation which the next code line gets from the first line in the code module used for the
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents("YassersDump").CodeModule.Lines(Startline:=1, Count:=1) ' First line has the
 Let strVonCodMod = Replace(Replace(Replace(strVonCodMod, "'_-Worksheets(""", ""), """).Range(""", " "), """)", "") ' we want to reduce and change like  "Worksheets("Sht").Range("A1")"  to   "Sht A1"    so that we can use split to get the Sheet name and the range address   strVonCodMod = Replace(strVonCodMod, "'_-Worksheets(""", "") :  strVonCodMod = Replace(strVonCodMod, """).Range(""", " ") :  strVonCodMod = Replace(strVonCodMod, """)", "")
 Set Ws = Worksheets(Split(strVonCodMod)(0)): Set Rng = Ws.Range(Split(strVonCodMod)(1)) ' The returned array from spliting by the space , " " ,  will have first element (indicie(0)) of like  "Sht"  and the second element (indicie(1))  of like  "A1"
'2b get range data
 Let strVonCodMod = ThisWorkbook.VBProject.VBComponents("YassersDump").CodeModule.Lines(Startline:=2, Count:=Rng.Rows.Count + 1) ' We need rows count+1 because there seems to be a last  & vbCr & vbLf    http://eileenslounge.com/viewtopic.php?f=30&t=31395#p242941
 Let strVonCodMod = Replace(strVonCodMod, "'_-", "", 1, -1, vbBinaryCompare) ' remove the '_- Comment bits
 Let strVonCodMod = Replace(strVonCodMod, " | ", vbTab, 1, -1, vbBinaryCompare) ' Replace the " | " with a carriage return
Rem 3 Put the string into the clipboard
Dim objDataObject As Object '
 Set objDataObject = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
 objDataObject.SetText strVonCodMod
 objDataObject.PutInClipboard
 Set objDataObject = Nothing
Rem 4 Output range data values to spreadsheet
 Ws.Paste Destination:=Rng
Rem 5
 On Error Resume Next
 ThisWorkbook.VBProject.VBComponents("YassersDump").CodeModule.DeleteLines Startline:=1, Count:=Rng.Rows.Count + 1 + 1 ' remove the first header row and all data and the extra last row caused by the extra  & vbCr & vbLf
End Sub

( XL2020alsm.xlsb https://app.box.com/s/26frr0zzc93q6zsraktove3qypqj714p )