YassersExtraCodes

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




Option Explicit '   http://eileenslounge.com/viewtopic.php?f=30&t=31395#p242964    ( XL2020alsm.xlsb https://app.box.com/s/26frr0zzc93q6zsraktove3qypqj714p )
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("Tabelle1").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("Tabelle1").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("Tabelle1").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("Tabelle1").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