I would like to copy text from Excel to a Word file, add a page break in between (between line 50 and 51) and format the table in the Word file adjust the width of the table to the page of the Word document.
I have tried the InsertBreak and SetWidth methods but somehow produce errors (either syntax or object not defined).
Sub Button1()
Dim wd As Object
Worksheets("1").Activate
Range("C15:C73").Copy
Set wd = CreateObject("word.application")
wd.documents.Add
wd.Visible = True
wd.activedocument.Range.Pasteexceltable False, False, True
Worksheets("2").Activate
End Sub
The above is the code I currently use which works but does not have the page break after line 50 included neither is the table correctly formatted, i.e. column is to wide.
Is somebody maybe so kind to help / point me in the right direction?
Try this code and customize it to fit your needs:
Sub Button1()
' Define object variables
Dim wordObject As Object
Dim wordDocument As Object
Dim wordTable As Object
Dim rangeToCopy As Range
' Define other variables
Dim sheetName As String
Dim rangeAddress As String
Dim rowToInsertBreak As Integer
' >>>>>Customize
sheetName = "Sheet1" ' Sheet name in Excel
rangeAddress = "C15:C73" ' Range in Excel to copy from
rowToInsertBreak = 25 ' (index starts at 0 and first row is the header
' Initiate word object
Set wordObject = CreateObject("Word.Application")
' Add a new document
Set wordDocument = wordObject.Documents.Add
' Make the window visible
wordObject.Visible = True
' Define the range to copy
Set rangeToCopy = ThisWorkbook.Worksheets(sheetName).Range(rangeAddress)
' Copy the range
rangeToCopy.Copy
' Paste it into word
wordDocument.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
' Reference the table we just pasted
Set wordTable = wordDocument.Tables(1)
' Autofit the table
wordTable.AutoFitBehavior 2 ' wdAutoFitWindow: Check https://learn.microsoft.com/en-us/previous-versions/office/developer/office-2003/aa211923(v%3Doffice.11)
' Insert the page break after row
wordTable.Rows(rowToInsertBreak).Range.InsertBreak Type:=7 ' wdPageBreak
' Clear The Clipboard
Application.CutCopyMode = False
End Sub
Here are some links you'd check:
How to properly copy and paste excel tables into word:
https://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba
Note: It's often better to use word as a reference
How to deal with page breaks inside Word tables:
https://shaunakelly.com/word/styles/page-breaks-in-tables.html
Related
I have a unique situation I am trying to find a way to implement:
I am working with word documents that are simple tables.. all of the information in the word doc is in a table. Some are hundreds of pages long, and are revised regularly. What I am trying to do is to (in excel from a macro) open the word document, scan it and copy over to excel only those rows from the table that are insertions.
I have managed to cobble together from various sources the code that will open the word doc and copy over ANY track changes... But for the life of me I cannot see or find a way to limit it to insertions, I'm hoping that someone may have some ideas...
Here is the code I am using now that works to bring over all tracked changes in the proper columns:
'declare variables
Dim ws As Worksheet
Dim WordFilename As Variant
Dim Filter As String
Dim WordDoc As Object
Dim tbNo As Long
Dim RowOutputNo As Long
Dim RowNo As Long
Dim ColNo As Integer
Dim tbBegin As Integer
Set ws = Worksheets("Analysis")
Filter = "Word File New (*.docx), *.docx," & _
"Word File Old (*.doc), *.doc,"
'clear all of the content in the worksheet where the tables from the Word document are to be imported
ws.Cells.ClearContents
'if you only want to clear a specific range, replace .Cells with the range that you want to clear
'displays a Browser that allows you to select the Word document that contains the table(s) to be imported into Excel
WordFilename = Application.GetOpenFilename(Filter, , "Select Word file")
If WordFilename = False Then Exit Sub
'open the selected Word document
Set WordDoc = GetObject(WordFilename)
With WordDoc
tbNo = WordDoc.Tables.Count
If tbNo = 0 Then
MsgBox "This document contains no tables"
End If
'nominate which row to begin inserting the data from. In this example we are inserting the data from row 1
RowOutputNo = 1
'go through each of the tables in the Word document and insert the data from each of the cells into Excel
For tbBegin = 1 To tbNo
With .Tables(tbBegin)
For RowNo = 1 To .rows.Count
For ColNo = 1 To .Columns.Count
'-----This code works to only select revisions ----------------
'-----Next step - make it only select insertions -
' OR - let it mark what kind of revision it is-----
Set rng = .Cell(RowNo, ColNo).Range
'don't include the "end of cell" marker in the checked range
'rng.MoveEnd wdCharacter, -1
numRevs = rng.Revisions.Count
If numRevs > 0 Then
ws.Cells(RowOutputNo, ColNo) = Application.WorksheetFunction.Clean(.Cell(RowNo, ColNo).Range.Text)
End If
Next ColNo
RowOutputNo = RowOutputNo + 1
Next RowNo
End With
RowOutputNo = RowOutputNo
Next tbBegin
End With
End Sub
For example:
If numRevs > 0 Then
For revIdx = 1 To numRevs
If Rng.Revisions(revIdx).Type = 1 Then
'it's an insert
End If
Next revIdx
I am new to VBA and macros.
I got the repeated task of copy data from Excel and paste it in a particular location in the word document.
For example, my excel sheet has the data like this:
Col1
Col2
ID_1
I'm_One
ID_2
I'm_Two
ID_3
I'm_Three
Now i'm looking for a Word macro
Get text in Word table with cell position 3
Find the same text in Excel Col1
Get the value of Col2 from Excel
Paste the value of Col2 in word table with cell position 10
Repeat the same process for another table in Word document
[Update]
I have tried with multiple code snippets by google search but unable to construct the working macro.
Sub pull_from_Excel2()
'ref: https://www.macworld.com/article/211753/excelwordvisualbasic.html
Dim Month As String
ID_Range = "A2:A6" 'Select this as range like "A2:A16"
Offset_to_fetch = 1 'Select this to fetch comments etc. value starts with
Set xlSheet = GetObject("D:\Excel.xlsx")
'Snippets:
'Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range("A3:A5").Value)
'8204
Dim Cell As Range, rng As Range
Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range(ID_Range).Value2)
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
For Each Cell In rng
Debug.Print Cell.Text
Next Cell
End Sub
I used this url to construct my skeleton code: https://www.macworld.com/article/211753/excelwordvisualbasic.html
When i try to get the values from the range of cells in excel, i got the following error for the code.
Set rng = xlSheet.Worksheets(1).Range(ID_Range).Value2
The above line gives "Object required" error when running.
Set rng = xlSheet.Worksheets(1).Range(ID_Range)
The above line gives "Type Mismatch" error when running.
Notes: For this error, I tried to use for each loop as this is array but the error is showing before executing the for loop.
Kindly assist.
I recommend to use Option Explicit and declare all your varibales properly. This way it is less likely that you end up with unseen errors.
To activate it for all new codes that you add in the future, you can activate it directly in Excel and Word. This is a good practice and will protect you from doing it wrong by notifying you of not declared variables:
In the VBA editor go to Tools › Options › Require Variable Declaration.
This will add Option Explicit to new modules only. In existing modules Option Explicit needs to be added manually as first line.
Further I highly recommend to name your variables according what they contain because otherwise it gets very confusing. You named your variable xlSheet but you load a workbook into it and not a worksheet.
The next issue is that your code is in Word and if you declare rng As Range then this is of type Word.Range and not Excel.Range and those are diffetent types so that is why you get a "Type Mismatch" error.
To solve this you either go in Word VBA to Extras › Refereces … and set a reference to the Excel library so you can declare your variable Dim xlRng As Excel.Range or if you don't set a reference you declare it as Object or Variant like in below example:
' This code is in Word!
Option Explicit
Public Sub pull_from_Excel2()
'declare constants
Const ID_Range As Sting = "A2:A6" 'Select this as range like "A2:A16"
Const Offset_to_fetch As Long = 1 'Select this to fetch comments etc. value starts with
Dim xlWorkbook As Object
Set xlWorkbook = GetObject("D:\Excel.xlsx") 'This expects the Excel to be already open! If not open you need to use CreateObject("Excel.Application")
Dim xlRng As Object
Set xlRng = xlWorkbook.Worksheets(1).Range(ID_Range)
Dim xlCell As Object
For Each xlCell In xlRng
Debug.Print xlCell.Text
Next xlCell
End Sub
Note if your workbook Set xlWorkbook = GetObject("D:\Excel.xlsx") is not open in Excel you need to use CreateObject("Excel.Application") and open it.
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWorkbook As Object
Set xlWorkbook = xlApp.Workbooks.Open(FileName:="D:\Excel.xlsx") 'will open the workbook
xlApp.Visible = True 'make it false to open Excel invisible in the background
'your code here …
'in the end close workbook and Excel (espaciall if you had it invisible!)
xlWorkbook.Close SaveChanges:=False
xlApp.Quit 'close Excel
Option Explicit
Sub UpdateTables()
Const XLSX = "D:\Excel.xlsx"
Dim xlApp, wb, ws
Dim rngSearch, rngFound
Dim iLastRow As Long, n As Integer
' open spreadsheet
'Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(XLSX, 1, 1)
Set ws = wb.Sheets(1)
iLastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row 'xlUp
Set rngSearch = ws.Range("A2:A" & iLastRow)
' update tables
Dim doc As Document, tbl As Table, s As String
Set doc = ThisDocument
For Each tbl In doc.Tables
s = tbl.Cell(1, 1).Range.Text
s = Left(s, Len(s) - 2)
Set rngFound = rngSearch.Find(s, LookIn:=-4163, LookAt:=1) ' xlValues, xlWhole
If rngFound Is Nothing Then
MsgBox "'" & s & "' not found in table " & tbl.Title, vbExclamation
Else
tbl.Range.Cells(3).Range.Text = rngFound.Offset(0, 1)
n = n + 1
End If
Next
wb.Close False
xlApp.Quit
MsgBox n & " tables updated", vbInformation
End Sub
I have a Word file with approximately 10 pages and 20 tables. Some of these tables have checkboxes. I want to copy these tables into an Excel file.
The following code copies all tables from my Word file into my Excel file:
Sub Import()
Option Explicit
Dim wb As Workbook
Dim sh As Worksheet
Dim sheet As Worksheet
Dim lzeile As Integer
Set wb = ActiveWorkbook
Set sh = wb.ActiveSheet
Set sheet = wb.Worksheets("Tabelle1")
Dim Btxt As Object
Set Btxt = CreateObject("Word.Application")
Btxt.Visible = True
Btxt.documents.Open "C:\Users\*.doc" '*=path
lzeile = 0
For i = 1 To 20
Btxt.ActiveDocument.Tables(i).Range.Copy
Application.Goto sheet.Cells(1 + lzeile, 1)
sheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
lzeile = sheet.Cells(Rows.Count, 1).End(xlUp).Row
lzeile = lzeile + 1
sheet.Cells(lzeile, 1) = "Tabelle" & i
Next i
Btxt.Quit
Set Btxt = Nothing
Set wb = Nothing
Set sh = Nothing
End Sub
It does not copy checkboxes or the value (0 = not checked / 1 = checked) of the checkbox.
I can write the value of a checkbox into a cell in my excel sheet with this line:
sheet.Cells(j, 10) = Btxt.ActiveDocument.Tables(i).FormFields.Item("Kontrollkästchen" & j).Result
With a loop j over all "Kontrollkästchen" (german translation of contentcontrol or formfield item) so basically the name of all formfield items in this Word file.
How can I get the position of these formfield items or identify which formfield item / ContentControl is in which table?
I tried to go through all rows and columns in each table because none of them are larger than 10x10. But I can´t find a way to check if a checkbox is maybe in table 3 on column 5 row 5 and then read the name of this checkbox to a safe the value (0 / 1) in the Excel cell on the same position in my copied table.
The solution depends on whether they're formfields or content controls.
Assuming they're formfields:
Sub Demo()
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
With .FormFields(i)
If .Type = wdFieldFormCheckBox Then
j = Abs(.CheckBox.Value)
Set Rng = .Range
.Delete
Rng.Text = j
End If
End With
Next
End With
End Sub
Assuming they're content controls:
Sub Demo()
Dim i As Long, j As Long, Rng As Range
With ActiveDocument
For i = .ContentControls.Count To 1 Step -1
With .ContentControls(i)
If .Type = wdContentControlCheckBox Then
j = Abs(.Checked)
Set Rng = .Range
.Delete
Rng.Text = j
End If
End With
Next
End With
End Sub
For the sake of simplicity and clarity, the sample code below leaves out the parts having to do with Excel, as well as creating the instance of the Word Application. It shows only how to access the Word document's checkboxes and convert those to static values.
At the end, also, the document is closed without saving changes, which means forms protection and the checkboxes should be left intact - the macro will not have affected them.
Note: You should have Option Explicit at the top of the code page, not inside a "Sub".
How it works
The document to be processed is opened and at that moment set to an object (doc). Use this instead of ActiveDocument as it will be much clearer and, in case the user would try to do something, won't affect macro execution.
If the document has forms protection, this must be turned off in order to delete the checkboxes and insert static values.
Then all the form fields are looped. If they are checkboxes, the value is determined, the checkbox removed and the value assigned to the range the checkbox occupied.
After this has completed comes the code to transfer data to Excel. Then the document is closed without saving changes.
Sub ConvertCheckBoxesToValues()
Dim ff As Object ' Word.FormField
Dim doc As Object ' Word.Document
Dim cbValue As String
Dim rngFF As Object ' Word.Range
Set doc = Btxt.Documents.Open("C:\Users\*.doc") '*=path
If doc.ProtectionType <> -1 Then 'wdNoProtection
doc.Unprotect
End If
For Each ff In doc.FormFields
If ff.Type = 71 Then 'wdFieldFormCheckBox
If ff.CheckBox.value = True Then
cbValue = "1"
Else
cbValue = "0"
End If
Set rngFF = ff.Range
ff.Delete
rngFF = cbValue
End If
Next
'Transfer the information to Excel, then
doc.Close 0 'wdDoNotSaveChanges
End Sub
I am trying to loop through Excel rows, where column A holds text that I want to find in Word. Column B holds what I want to paste in Word after the end of the paragraph in which the text is found.
When working in Word VBA, the find text is working and moving to the end of the paragraph works. But when I move to Excel VBA, the find method doesn't seem to be doing anything.
Sub UpdateWordDoc1()
Dim mywb As Excel.Worksheet
Set mywb = ActiveWorkbook.ActiveSheet
Dim wdDoc As Object, wdApp As Object
Dim questiontext As String
Dim oSearchRange
On Error Resume Next
Set wdDoc = CreateObject("C:\mydoc.docx")
Set wdApp = wdDoc.Application
Set oSearchRange = wdDoc.Content
With mywb
For i = 2 To .Range("A6000").End(xlUp).Row
questiontext = .Range("A" & i).Value
.Range("B" & i).Copy
Set blabla = oSearchRange.Find.Execute.Text = questiontext
blabla.Select
Selection.movedown unit:=wdparagraph
Selection.moveleft unit:=wdcharacter
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Next i
End With
'wdDoc.Close savechanges:=True
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
I think this code does what you're after. I made a number of small changes to the code in the original post, some important, some not so much. Hopefully the comments help explain why I did what I did:
Sub UpdateWordDoc1()
' REQUIRES A REFERENCE TO:
' Microsoft Word ##.# Object Library
Dim myws As Excel.Worksheet ' Changed wb to ws to better abbreviate worksheet
Dim wdDoc As Word.Document ' No longer a generic object
Dim wdApp As Word.Application ' No longer a generic object
Dim questiontext As String
Dim oSearchRange As Word.Range ' Word range is what will be searched
Dim i As Long ' Loop through rows by count (Long)
Set myws = ActiveWorkbook.ActiveSheet
' On Error Resume Next ' Can't find bugs if they're supressed!!!
Set wdApp = CreateObject("Word.Application") ' Create app before opening doc
' Need to explore what happens
' if Word is already running
wdApp.Visible = True ' Make it visible so we can watch it work
Set wdDoc = wdApp.Documents.Open("C:\mydoc.docx") ' Open the doc
With myws
For i = 2 To .Range("A6000").End(xlUp).Row
' Word's Find function is tricky to program, because
' when Find succeeds, the range is moved! (Find has many
' other odd behaviors). Assuming you want to search the entire doc
' for each search term, we reset the range every time through the
' loop.
Set oSearchRange = wdDoc.Content
questiontext = .Range("A" & i).Value
.Range("B" & i).Copy
' Set blabla = oSearchRange.Find.Execute.Text = questiontext
With oSearchRange.Find
' Note that Word's Find settings are "sticky". For example, if
' you were previously searching for (say) italic text before
' running this Sub, Word may still search for italic, and your
' search could fail. To kill such bugs, explicitly set all of
' Word's Find parameters, not just .Text
.Text = questiontext ' This is what you're searching for
If .Execute Then ' Found it.
' NOTE: This is only gonna make a change
' at the first occurence of questiontext
' When find is successful, oSearchRange will move
' to the found text. But not the selection, so do Select.
oSearchRange.Select
' Now move to where the new text is to be pasted
wdDoc.ActiveWindow.Selection.movedown unit:=wdparagraph
wdDoc.ActiveWindow.Selection.moveleft unit:=wdcharacter
' While debugging, the next statement through me out of single
' step mode (don't know why) but execution continued
' and the remaining words in my list we're found and text
' pasted in as expected.
wdDoc.ActiveWindow.Selection.PasteAndFormat (wdFormatOriginalFormatting)
End If
End With
Next i
End With
' Clean up and close down
wdDoc.Close savechanges:=True
Set oSearchRange = Nothing
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing
Set myws = Nothing
End Sub
Hope that helps
I wrote a code in vbscript as below ,but when i run my script it is giving an error saying the "Range" is undefined. Can any help me here by saying what is the error?
For TaskCounter = 1 to 35
TaskRangeFrom="Task"&TaskCounter&" Start Date"
TaskRangeTo="Task"&(TaskCounter+1)&" Name"
objSheet6.Range(Range(TaskRangeFrom).Offset(,1), _
Range(TaskRangeTo).Offset(,-1)).EntireColumn.Delete
Next
Thanks in advance.
As #NickSlash mentioned yesterday, I doubt that you have given range names like
"Business Process ID" (containg spaces) to your columns. But as this may be
a version thing, I show you how to get a 'whole column' range object for a
column named "TaskB" (via the "define name" dialog):
' Range by Name
Set oRng = oWs.Range("TaskB")
To get a range for the second column by (column) number, use:
' Range by Number
Set oRng = oWs.Cells(1, 2).EntireColumn
Please note: row and column numbers start with 1. So your ".Offset(,1)"
code looks very fishy; it may have caused the "Unknown runtime error".
If you - as I suppose - wrote your column titles in the first row, you'll
have to loop over the columns of that row and check the values:
' Range by Lookup
Set oRng = Nothing
For nCol = 1 To 5
If "Title B" = oWs.Cells(1, nCol).Value Then
Set oRng = oWs.Cells(1, nCol).EntireColumn
Exit For
End If
Next
If you want to experiment, insert those snippets into test code like:
Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim sDir : sDir = oFS.GetAbsolutePathname("..\xls")
Dim sFSpec : sFSpec = oFS.BuildPath(sDir, "work.xls")
' Start clean
oFS.CopyFile oFS.BuildPath(sDir, "13763603.xls"), sFSpec
' Open .XLS
Dim oXls : Set oXls = CreateObject("Excel.Application")
Dim oWb : Set oWb = oXls.Workbooks.Open(sFSpec)
Dim oWs : Set oWs = oWb.Worksheets(1)
Dim oRng, nCol
' Range by XXX
...
oXls.Visible = True
WScript.Stdin.ReadLine
If Not oRng Is Nothing Then
oRng.Delete
WScript.Stdin.ReadLine
End If
oXls.Visible = False
oWb.Close False
oXls.Quit
Pics to give evidence:
To delete an entire column in VBScript simply do the following; This will delete the entire column A
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open _
("C:\myworkbook.xlsx")
objExcel.Visible = True
objWorkbook.Worksheets("Sheet1").Range("A:A").Delete
In VBA (macro's) just call the code below. This will delete the A column on the active sheet.
Range("A:A").Delete
Having seeing some complications in VBScript compared to VBA I would suggest the following rather-lazy method.
The easiest way to do anything VBScript-related in most office apps, Excel being one of them, is to start recording a macro, do what you wish manually, and then read the VBA that is generated and convert that VBA to VBScript.
Anyway here's some code to help you. Delete column E.
Const xltoLeft = -4131
StrName as string
StrName = "myfield"
Set NewWorkBook = objExcel.workbooks.add()
With objExcel
.Sheets("Sheet1").Select '-- select is a very bad practice, I'll update it later
'-- run your for loop
'for i= blah blah
If range.offset(0,i) = StrName then
Range.offset(0,i).Entirecolumn.delete xltoLeft
Msgbox "magical deletion"
Exit for
End if
'next i
End With
Reference : DELETE EXCEL COLUMN IN VBSCRIPT