Results 1 to 10 of 190

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

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #11
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10

    Sub PubProliferous_Let_RngAsString__()

    Routine for following excelfox Thread:
    http://www.excelfox.com/forum/showth...0863#post10863 ...


    Code:
    Sub PubProliferous_Let_RngAsString__() ' Make hardcopy of spreadsheet range to VB Editor insensibly  http://www.eileenslounge.com/viewtopic.php?f=30&t=31395#p243002
    Rem 0 VBA project instantiated VBIDE
    Dim VBIDEVBAProj As Object ' For convenience a variable is used for this code module
     Set VBIDEVBAProj = ThisWorkbook.VBProject.VBE.ActiveCodePane.codemodule                                                 ' ThisWorkbook.VBProject.VBComponents(Me.CodeName) 'varible referring to this code module
    Rem 1 Indicate that this module is being used for text.
        If Not Right(VBIDEVBAProj.Name, 4) = "_txt" Then Let VBIDEVBAProj.Name = VBIDEVBAProj.Name & "_txt" ' If Not Right(Me.CodeName, 4) = "_txt" Then Let VBIDEVBAProj.Name = Me.CodeName & "_txt"
    Rem 2 Selected range to clipboard
    Dim rngSel As Range: Set rngSel = Selection: rngSel.Copy
    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
    Dim strIn As String: strIn = objDataObject.GetText() 'This gets the test string from the Data Object
    ' rngSel.ClearContents ' range is cleared after copying table values to clipboard
    Rem 3
    '3a) replace vbTab with  "|"  as cell divider to use in the VB editor range value display
     Let strIn = Replace(strIn, vbTab, "|") '                                                             : Call WotchaGot(strIn)
    '3b) typically the last two "characters" from the text obtained from a spreadsheet range via the clipboard has a last vbCr & vbLf pair. We rely on this in further lines so this is just to be sure
       If Not Right(strIn, 2) = vbCr & vbLf Then Let strIn = strIn & vbCr & vbLf ' Typically a last vbcr & vblf is there, and we rely on it, so we make sure here ###
    Rem 4 add start and stop info
     Let strIn = "'_-" & Format(Date, "DD MM YYYY") & " Worksheets(""" & rngSel.Parent.Name & """).Range(""" & rngSel.Address & """)" & vbCr & vbLf & strIn & "'_- EOF " & Format(Date, "DD MM YYYY") ' Note in last bit I am relying on having a vbcr & vbLf after existing strIn ###
    Rem 5 Make array from string using the  vbCr & vbLf  pair as seperator.  This willbe an array of  data and the extra start and end rows
    Dim SpltRws() As String: Let SpltRws() = Split(strIn, vbCr & vbLf, -1, vbBinaryCompare)
    Rem 6 Determination of code module table characteristics
    '6a) from split rows array, we can get the number of columns and rows
    Dim RwCnt As Long, ClCnt As Long
     Let RwCnt = (UBound(SpltRws()) - LBound(SpltRws())) + 1 ' Allow for any base
    Dim SpltCls() As String: Let SpltCls() = Split(SpltRws(LBound(SpltRws()) + 1), "|", -1, vbBinaryCompare) ' assume second row is representative of all rows for column number
     Let ClCnt = (UBound(SpltCls()) - LBound(SpltCls())) + 1
    '6b) The next line is a way to make a free line...   Because we give a line number in the argument .insertlines Line:= of greater than the current last line number, then that actual number given bears no relation to the actual line number of the code line at which it will be added. ( The line number of the code I am talking about here is , as defined by, or rather as held internally by, and accessed in code coding, by a sequential integer starting at 1 at the top of the code window and counting by +1 for every successive line/row )  Because we give a line number in the argument .insertlines Line:= of greater than the current last line number, then lines will always be added at the next free line, that is to say one line above the last used line. The actual number we give is irrelevant, for numbers we give which are greater than that of the current last used line in the code module.
     VBIDEVBAProj.insertlines Line:=VBIDEVBAProj.countoflines + 9996, String:="" ' An attempt to insert a line anywhere above the last used line will force a new line at the end. So this is how we force a space. (Trying to insert a line anywhere above the last used line won't work.
    '6c) Find next free row and last row that we will effectively use
    Dim CdTblStt As Long, CdTblStp As Long ' these variables will actual hold our start and end lines, but when used below they actually force a new line by virtual of attempting to insert a line above the current last line
     Let CdTblStt = VBIDEVBAProj.countoflines + 1 ' We find that + 1 or more will take us to the next free line. (We can insert below or equal to last used line and then all will be shifted up. If we add to the last line  =___.CountOfLines  then the last line will shift up. Effectively CdTblStt is the start row as it is one up from the last row. But if we used any number >=1 for the 1 , then the actual start line which we obtain would still be at  .countoflines + 1
     Let CdTblStp = CdTblStt + RwCnt - 1 ' last row in this code module to be used. In actual fact this nimber is what it will be. Effectively with using this later in our code, we try to insert at one line furthter than the last line. For any attempt at an insert >= .countoflines+1 we actually add a new line at the end.
    Rem 7 Add lines from array to to code module , using some string formating                                       http://www.excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings  ---   Dim TabulatorSyncrenator As String: Let TabulatorSyncrenator = "123456789" ' any lengthed string
    '7a) Header
     VBIDEVBAProj.insertlines Line:=CdTblStt, String:=SpltRws(LBound(SpltRws()))
    '7b) Main looping Start for data rows ===============================
    Dim Rws As Long
        For Rws = CdTblStt + 1 To CdTblStp - 1 Step 1 ' At each row of data
        Dim rvec As Long:  Let rvec = -CdTblStt + LBound(SpltRws()) ' This gives the adjustment necerssary to take us from a code module line number to an array indicie in the range rows array, SpltRws(). This works as follows: Our used row number actually forces a new line which has that line number. For the relavant array line number, for example , the first line will need to be the first indicie. For zero base, we need to take off excactly  CdTblStt  For base 1 iwe need to take off 1 less,  so rvec  would be  -(CdTblStt + 1)
         Let SpltCls() = Split(SpltRws(Rws + rvec), "|", -1, vbBinaryCompare) 'Split each data row into data columns
        '7c) to allow some formatting, a string is built up from each column/cell value
        Dim Cls As Long
            For Cls = LBound(SpltCls()) To UBound(SpltCls())
            Dim TabulatorSyncrenator As String: Let TabulatorSyncrenator = "123456789" ' any lengthed string will do
             LSet TabulatorSyncrenator = Trim(SpltCls(Cls)) '   this cause a number like " 56" to change to "56       "  This allows us to have a fixed length format here in the displayed code editor
            Dim LineAut As String
             Let LineAut = LineAut & " | " & TabulatorSyncrenator ' : Debug.Print LineAut
            Next Cls
         Let LineAut = Replace(LineAut, " | ", "'_-", 1, 1, vbBinaryCompare) 'Replace first " | " with some sort of 'comment thing
         VBIDEVBAProj.insertlines Line:=Rws, String:=LineAut ' Note: you could use any from and including one more than the last current line. - effectively here we always try to go >=+1, we are not really defining the line, but just making sure that we add on to the end. Effectively the number in the Line:= does become the line where the string is finally. But it is not directly defined by that.
         Let LineAut = "" ' Ready for next line use
        Next Rws ' End main data rows Loop ==============================
    '7d) End row
     VBIDEVBAProj.insertlines Line:=CdTblStp, String:=SpltRws(UBound(SpltRws())) ' Note: this line would not go further than last line, so it must be done here ***
    End Sub
    Last edited by DocAElstein; 12-26-2018 at 04:53 PM.

Similar Threads

  1. VBA to Reply All To Latest Email Thread
    By pkearney10 in forum Outlook Help
    Replies: 11
    Last Post: 12-22-2020, 11:15 PM
  2. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM
  3. Replies: 19
    Last Post: 04-20-2019, 02:38 PM
  4. Search List of my codes
    By PcMax in forum Excel Help
    Replies: 6
    Last Post: 08-03-2014, 08:38 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •