-
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
-
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! :)
-
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
-
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.
-
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)...
Code:
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...
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...
Code:
Call XLTableToWord("Markers")
-
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! :bug:
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!
-
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
-
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
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)
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
-
Sorry for the slow reply, Dave - VBA Express Forum has been playing up for me today. :dunno
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)
Code:
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)
Code:
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
-
:igiveup: Good luck. Be Safe. Dave
-
Glad to see you made it back, Alice.:mayi:
-
I'm really sorry about not being clear about the requirement of needing anything from 1 to 4 tables, Dave. :sad2:
-
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!
Code:
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
-
The Excel Collection Object "Sheets" does not have a "Range" Property (Data Member or Method)
Learn what F2 in VBA has to offer
-
Stupid rabbit with that shiny watch... see #16, #45 & #48
Code:
objExcel.Range(SheetName).Copy
Dave
-
:o:
What can I say? Thanks, Dave!