Consulting

Page 3 of 3 FirstFirst 1 2 3
Results 41 to 56 of 56

Thread: Import Worksheets Into TextBox

  1. #41
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    I guess I should have checked my originally posted code before my previous post. That code was tested and works... So, do you have sheets in Triage named Person, Person1, Markers & Markers1? Your original test file did not. Whatever happened to your notion of loading the XL table somewhere (in a Textbox... if U can still spell it without those keys )and then editing the table before U placed in the Word document? Anyways, I did kick around a method for that by adding the table to a listbox and then using some textboxes to change the listbox selections, but I'm not quite sure that's what U want or how U would want it presented in the document? In table format or something else? One thing at a time, do U have all of those sheet names? Dave
    ps. Maybe just use the code here...
    Copy & Paste Multiple Excel Tables Into Microsoft Word With VBA — The Spreadsheet Guru

  2. #42
    Hey Dave, I mentioned a few posts back after being given a polite 'nudge' by Sam that I'd ditched the 'load two Excel table's data into TextBox' routine.

    Anyway, yes I do have the four worksheets in Triage.xlsm

    Although the link you have provided certainly provides a possible solution, I'd really prefer to use Word as the driving program, as the Excel data is only a small part of the form data that the user requires to put into the document.

    I cannot see that the code can be too far off, there must be something really "simple" that needs adding or altering.

    I've obviously checked that I have the Microsoft Excel 16.0 Object Library selected!

  3. #43
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    As stated that code still works for me. U never answered the question... "Whatever happened to your notion of loading the XL table somewhere (in a Textbox... if U can still spell it without those keys )and then editing the table before U placed in the Word document?" ... I thought that was your objective???? Dave
    ps. I did say somewhere ie. NOT in a textbox

  4. #44
    The actual Excel imported data doesn't need to be altered, just a short piece of text before each of the tables to provide an explanation of what each table contains. To make things easier the text will always be fairly constant, dependent only on which table data is imported into the document.

    Hence my thinking of something along the lines of using the Case method (eventually).

    If Markers or Markers1 is used, then the text will be "These are the markers shown" & vbCr & vbCr
    If Person or Person1 is used, then the text will be "These are the records shown for the past eighteen months" & vbCr & vbCr

    If Markers or Markers1 is not used, then the text will be "No records held" & vbCr & vbCr
    If Person or Person1 is not used, then the text will be "Currently no records can be found" & vbCr & vbCr

    This is why my previous idea of importing into a TextBox is actually not required. My only reason originally was only to add the lines of text as mentioned above. No other reason.


    Sorry, I still cannot get your code to work. I must be doing something wrong somehow but I just cannot fathom how.

    I'm still hoping that my code in post #38 can be "tweaked" to make it work.

  5. #45
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    Problem is that #38 will never work! Also that is NOT the code from #16 and I'm guessing if you're running code from #38, U never quit XL and keep calling the function and then U have lots of XL applications still running. Use your task manager to end the processes or there's no chance of any code working. U need to have an external data table with the name of "Externaldata_1" in EVERY sheet for the following code to run. Anyways, apologies for not understanding your outcome objective. I'm assuming that U only want to import 1 table at a time to your document. Code tested and works. Dave
    Module code (32 bit instal)...
    Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Public Declare Function CloseClipboard Lib "user32" () As Long
    Public Declare Function EmptyClipboard Lib "user32" () As Long
    Userform code...
    Public Function XLTableToWord(SheetName As String)
    Dim objExcel As Object, objWorksheet As Object, WordTable As Object
    On Error GoTo ErFix
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
    Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
    objExcel.Range("Externaldata_1").Copy
    
    
    With ActiveDocument
    'clear document
    .Range(0, .Characters.Count).Delete
    .Content.InsertParagraphBefore
    
    
    Select Case SheetName
    Case "Markers": .Content.InsertBefore "These are the markers shown" '& vbCrLf
    Case "Person": .Content.InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
    Case "Markers1": .InsertBefore "These are the markers shown" '& vbCrLf
    Case "Person1": .InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
    End Select
    End With
    'insert table
    With ActiveDocument.Paragraphs.Last.Range
    .PasteExcelTable False, False, False
    Set WordTable = ThisDocument.Tables(1)
    WordTable.AutoFitBehavior (wdAutoFitWindow)
    End With
    'clean up
    ErFix:
    If Err.Number <> 0 Then
    On Error Resume Next
    MsgBox "Error"
    End If
    Set WordTable = Nothing
    objExcel.DisplayAlerts = False
    objExcel.Workbooks("Triage.xlsm").Close
    Set objWorksheet = Nothing
    objExcel.Quit
    Set objExcel = Nothing
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
    End Function
    To operate example...
    Call XLTableToWord("Markers")

  6. #46
    Thanks for this, Dave!

    You are correct in that I did amass a number of Excel applications running at the same time and had to keep closing them!

    Now I've hit upon another slight snag - my limited knowledge of Excel! You mention an "external data table", which I had to perform a Google search on. This is a completely new thing to me, so was thinking how this will accept the data that will need to go into each of the worksheets. Because there is a bespoke third party program, the only option for obtaining the data in the first instance is via an option in this program to "Export as Excel worksheet". It will not allow me to create a direct link to Excel to accept the data. It creates a new instance of Excel with a default sheet name of 'Sheet1'.

    I think that I've managed to create these "external data tables", but have noted that they have defaulted to have column headers of 'column1', 'column2' etc. , along with a bit of blue colouring. A couple of questions:-

    1) Will these headings and styling be imported into the final tables? This will not be required.

    2) Do I just paste from the original source (produced from the bespoke program) into this and then drag a selection around the data that needs to be transferred?

    If there is data to export, this will always contain three columns for 'Markers' and 'Markers1' and four columns for 'Person' and 'Person1'. In each case the data could contain anything from a single row up to say a hundred.

    I already have a couple of macros to "tidy" the data to remove pointless columns / rows and to apply sorting criteria.

    Sorry for all the questions, but my knowledge of VBA is in its infancy and these "external data tables" are also new to me. Determined to get this sorted though!

    Thanks!

  7. #47
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    Please review thread #16. "Because there is a bespoke third party program, the only option for obtaining the data in the first instance is via an option in this program to "Export as Excel worksheet". It will not allow me to create a direct link to Excel to accept the data. It creates a new instance of Excel with a default sheet name of 'Sheet1'." YOU ALREADY HAVE AN "ExterbalData_1" TABLE IN EACH SHEET!!! The exported table is given the named range ExterbalData_1. The XL file U posted does and I assume that every exported sheet will be the same. Go to the name manager box (top left) click the scroll button and U will see ExterbalData_1 there. Click on it and it will highlight your imported table. No need to create anything or link anything. Trial the code with the test file U posted. Dave

  8. #48
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    Arghh... "I already have a couple of macros to "tidy" the data to remove pointless columns / rows and to apply sorting criteria." The actual imported data has empty column/rows??? I thought that was just a product of U creating a sample wb. You can use the following code to avoid your couple of macros as long as there is always data in A1 and the sheet ONLY has the exported data. The code I provided will continue to include the pointless columns/rows unless you have redefined what the "Externaldata_1" range refers to. I really hate using usedrange as unexpected results occur ie. even if blank cells unrelated to your range of interest have been formatted, XL may decide to include them in your usedrange. Last code and please don't indicate that U want more than 1 table in the document because that's quite a bit different. Dave
    Public Function XLTableToWord(SheetName As String)Dim objExcel As Object, objWorksheet As Object, WordTable As Object
    On Error GoTo ErFix
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
    Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
    With objWorksheet
    .Activate
    .Usedrange.Copy
    End With
    'objExcel.Range("Externaldata_1").Copy
    With ActiveDocument
    'clear document
    .Range(0, .Characters.Count).Delete
    .Content.InsertParagraphBefore
    
    
    Select Case SheetName
    Case "Markers": .Content.InsertBefore "These are the markers shown" '& vbCrLf
    Case "Person": .Content.InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
    Case "Markers1": .InsertBefore "These are the markers shown" '& vbCrLf
    Case "Person1": .InsertBefore "These are the records shown for the past eighteen months" '& vbCrLf
    End Select
    End With
    'insert table
    With ActiveDocument.Paragraphs.Last.Range
    .PasteExcelTable False, False, False
    Set WordTable = ThisDocument.Tables(1)
    WordTable.AutoFitBehavior (wdAutoFitWindow)
    End With
    'clean up
    ErFix:
    If Err.Number <> 0 Then
    On Error Resume Next
    MsgBox "Error"
    End If
    Set WordTable = Nothing
    objExcel.DisplayAlerts = False
    objExcel.Workbooks("Triage.xlsm").Close
    Set objWorksheet = Nothing
    objExcel.Quit
    Set objExcel = Nothing
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
    End Function

  9. #49
    Sorry for the slow reply, Dave - VBA Express Forum has been playing up for me today.

    Many thanks for this latest code!

    I do have to run a couple of Macros from Excel to do some tidying and arranging. You're not going to like me, but yes, my word document could have from one to four of these tables, depending on the user's requirement.

    My Macros always ensure that data is in cell A1, but will require my macros. These are as follows:-

    First for Markers (& Markers1)

    Sub Markers()
    
        ' Check for cells in column D that contain 'To'
        ' If any cells do then delete column
    
        Dim Cell   As Range, ws As Worksheet
    
        Set ws = Sheets("Markers")
        
        For Each Cell In ws.Range("$D:$D")
            Cell.Value = "To"
            Cell.EntireColumn.Delete
        Next Cell
        
        ' Format date in column C
        Range("$C:$C").NumberFormat = "dd/mm/yyyy"
        
        ' Delete first three rows
        Sheets("Markers").Range("$1:$3").EntireRow.Delete
        
        ' Sort Markers
        Dim rData       As Range, rData1 As Range, rData2 As Range
        Dim r           As Long, i As Long, iLastSort As String
        Dim arySorts    As Variant
        Dim sLastSort   As String
        
        arySorts = Array("Checked", "Ignored", "Important", "Untested", "Trial") ' starts at 0
        
        Set rData = ActiveSheet.Cells(1, 1).CurrentRegion
        Set rData1 = rData.Cells(2, 1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
        
        Application.AddCustomList ListArray:=arySorts
        
        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add Key:=rData1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=Application.CustomListCount
            .SortFields.Add Key:=rData1.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
            .SetRange rData
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
            .SortFields.Clear
        End With
        
        Set rData2 = Nothing
        With rData
            
            'see which last sort is in data
            For i = UBound(arySorts) To LBound(arySorts) Step -1
                iLastSort = -1
                On Error Resume Next
                iLastSort = Application.WorksheetFunction.Match(arySorts(i), Application.WorksheetFunction.Index(rData, 0, 2), 0)
                On Error GoTo 0
                
                'found custom sort value
                If iLastSort > -1 Then
                    sLastSort = LCase(arySorts(i))
                    Exit For
                End If
            Next i
        End With
        
        'custom sort value found
        If Len(sLastSort) > 0 Then
            
            With rData
                For r = .Rows.Count To 3 Step -1
                    If LCase(.Cells(r, 2).Value) = sLastSort Then
                        Set rData2 = .Cells(r + 1, 1)
                        Set rData2 = Range(rData2, rData2.End(xlDown).End(xlToRight))
                        Exit For
                    End If
                Next
            End With
            
            'MsgBox rData2.Address
            With ActiveSheet.Sort
                .SortFields.Clear
                .SortFields.Add Key:=rData2.Columns(3), SortOn:=xlSortOnValues, Order:=xlDescending
                .SetRange rData2
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
                .SortFields.Clear
            End With
            
        End If
        
        Application.DeleteCustomList ListNum:=Application.CustomListCount
         
        ' Delete first column
        Sheets("Markers").Range("$A:$A").EntireColumn.Delete
        
    End Sub
    The second for Person (& Person1)

    Option Explicit
    Sub Triage()
    
        ' Triage Macro
    
        'Delete any row containing the words 'Z INFORMATION SHARING' in column D
        Dim i           As Long
        For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
            If InStr(Cells(i, 4), "Z INFORMATION SHARING") Then
                'If InStr(Cells(i, 4), "Z INFORMATION SHARING") Or InStr(Cells(i, 4), "Abcdef") Then
                Rows(i).Delete
            End If
        Next
        
        
        'Perform the basic editing
        'Delete first column
        
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        
        ' Find and remove all instances of [O]
        
        Columns("B:B").Select
        Selection.Replace What:=" [O]", Replacement:="", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                          ReplaceFormat:=False
        
        'Format date column
        
        Range("$D:$D").NumberFormat = "dd/mm/yyyy"
        
        'Delete columns not required
        
        Columns("E:E").Select
        Selection.Delete Shift:=xlToLeft
        ActiveWindow.SmallScroll ToRight:=-1
        Rows("1:3").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
        
        'Delete all rows with a date older than eighteen months
        Application.ScreenUpdating = False
        ActiveSheet.AutoFilterMode = False
        Dim FilterRange As Range, myDate As Date
        myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
        Set FilterRange = _
            Range("D:D" & Cells(Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        ActiveSheet.AutoFilterMode = False
        Application.ScreenUpdating = True
        
        
        'Select all remaining cells with data in them
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        
    End Sub

  10. #50
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    Good luck. Be Safe. Dave

  11. #51
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,309
    Location
    Glad to see you made it back, Alice.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  12. #52
    I'm really sorry about not being clear about the requirement of needing anything from 1 to 4 tables, Dave.

  13. #53
    I've managed to rename each of the tables by producing another sub. Each of the tables is now named as Markers, Markers1, Person and Person1, as are each of the worksheets.

    Just need to know how to change the final line of this code so that the relevant table is copied to the clipboard. The final line is producing a 'Compile error: Method or data member not found'.


    Hoping that this is possible? I should be able to take things from there. Thanks!

    Public Function XLTableToWord(SheetName As String)
        Dim objExcel As Object, objWorksheet As Object, WordTable As Object, objName As Object
        On Error GoTo ErFix
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Workbooks.Open (ThisDocument.Path & "\Triage.xlsm")
        Set objWorksheet = objExcel.Workbooks("Triage.xlsm").Sheets(SheetName)
        Sheets.Range(SheetName).Copy

  14. #54
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,309
    Location
    The Excel Collection Object "Sheets" does not have a "Range" Property (Data Member or Method)

    Learn what F2 in VBA has to offer
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  15. #55
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    715
    Location
    Stupid rabbit with that shiny watch... see #16, #45 & #48
    objExcel.Range(SheetName).Copy

    Dave


  16. #56


    What can I say? Thanks, Dave!

Posting Permissions

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