I have an open Word document with a bunch of bookmarks, each with an inline image of an Excel table previously exported from Excel.
Now, I need to update the tables in the Word document as they have changed in Excel.
The way I'm doing this is matching the table names in Excel with the bookmark names in Word. If they are equal than I want to replace the existing images in Word by the current ones.
This is my code so far:
Sub substituir()
Set WordApp = GetObject(class:="Word.Application")
Set DocumentoDestino = WordApp.ActiveDocument
For Each folha In ThisWorkbook.Worksheets
If folha.Visible Then
'loop all excel tables
For Each tabela In folha.ListObjects
tabela.Name = Replace(tabela.Name, " ", "")
nomeTabela = tabela.Name
For Each myBookmark In DocumentoDestino.Bookmarks
If Right(myBookmark.Name, 4) = "PGST" Then
'This is where I need help
If myBookmark.Name = nomeTabela Then
'code to clear the table already in myBookmark here
'then copy and paste tables in myBookmark
tabela.Range.Copy
myBookmark.Range.PasteSpecial link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
End If
End If
Next myBookmark
Next tabela
End If
Next folha
End Sub
I've tried lots of different approaches, from deleting the bookmark and adding it back again to others, but nothing seems to work.
In the comment: 'code to clear the table already in myBookmark here I need help.
In the following code, I have tried to include the syntax you might require for your project.
Private Sub TestMark()
Dim Mark As String
Dim Rng As Range
Dim ShpRng As Range
Mark = "Text1"
With ActiveDocument
If .Bookmarks.Exists(Mark) Then
Set Rng = .Bookmarks(Mark).Range
If Rng.InlineShapes.Count Then
Set ShpRng = Rng.InlineShapes(1).Range
With ShpRng
Debug.Print .Start, .End
End With
End If
End If
End With
End Sub
Of course once you know the Start and End of the range you can manipulate it, meaning delete and replace it.
It just occurs to me that you might use the InlineShape' Caption property to find and address it.
Related
I have about 300 named ranges that are referring to an external spreadsheet.
for example
Range name: my_range
Refers to: ='\mycompany.com\lucas[Lucas.xlsm]SHEETNAME'!$C$10
I want to replace the "\mycompany.com\lucas[Lucas.xlsm]" with an empty string
I tried researching this online but it doesn't seem like I'm able to phrase it correctly, all the answers are referring to find and replace in cells...
There are a number of resources for doing this in VBA (300+ is a lot to do by hand!).
A great general guide is here: The SpreadsheetGuru's guide to Named Ranges in VBA
To loop through all named ranges and all named ranges in a specific worksheet:
Sub NamedRange_Loop()
'PURPOSE: Delete all Named Ranges in the Active Workbook
'SOURCE: www.TheSpreadsheetGuru.com
Dim nm As Name
'Loop through each named range in workbook
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name, nm.RefersTo
Next nm
'Loop through each named range scoped to a specific worksheet
For Each nm In Worksheets("Sheet1").Names
Debug.Print nm.Name, nm.RefersTo
Next nm
End Sub
To change the link, instead of using Debug.Print, edit the RefersTo. I can't find a way to directly edit the link, all the documentation suggest that you'd have to delete the link and recreate it with a new reference.
Deleting is easy - nm.Delete
Creating is easy:
'For Workbook level links
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
'For Worksheet level links
Worksheets("Sheet1").Names.Add Name:=RangeName, RefersTo:=cell
See also:
Names Object
Names.Add Method
Defining and using names in VBA formulas
Looping through all named ranges in excel VBA in current active sheet
If you replace the referring address of a named range with an empty string, Excel deletes the named range. And this is the way I am using to delete a named range:
Public Sub DeleteName(sName As String)
On Error GoTo DeleteName_Error
ActiveWorkbook.Names(sName).Delete
Debug.Print sName & " is deleted!"
On Error GoTo 0
Exit Sub
DeleteName_Error:
Debug.Print sName & " not present or some error"
On Error GoTo 0
End Sub
Simply call it like this:
DeleteName my_range
Actually, the deletion of the named range without .RefersTo is quite clever by the Excel developers - otherwise plenty of errors would appear. Check it out, this code would run only once if you declare my_range1 and my_range2:
Public Sub TestMe()
Dim nameArray As Variant
nameArray = Array("my_range1", "my_range2")
Dim myNameRange As Name
For Each myNameRange In ThisWorkbook.Names
Dim cnt As Long
For cnt = LBound(nameArray) To UBound(nameArray)
If nameArray(cnt) = myNameRange.Name Then
Debug.Print myNameRange
Debug.Print myNameRange.RefersTo
myNameRange.RefersTo = vbNullString
End If
Next cnt
Next myNameRange
End Sub
You should be able to do that from the Data, Edit Links dialog. Select the link in question, click change source and point it to the workbook itself.
If that fails, download my FlexFind tool (http://jkp-ads.com/officemarketplaceff-en.asp), run it and make sure you check the Objects checkbox on the dialog.
I want to copy a range of cell (values only/ text) to the clipboard so the user does not have to do a paste special values only when they paste them into another spreadsheet.
Here is what I have so far:
Private Sub CommandButton1_Click()
With New DataObject
.SetText Range("A32:Q32").Text
.PutInClipboard
End With
'Range("A32:Q32").Copy
End Sub
This gives me a runtime error
94 Invalid use of Null
If I just use the commented out code Range.("A32:Q32").Copy it copies the formulas and unless the user does the special paste they get all kinds of reference errors.
It's a bit convoluted, but get text > clear clipboard > put text back :
[A32:Q32].Copy
With New DataObject
.GetFromClipboard
s = .GetText
.Clear
.SetText s
.PutInClipboard
End With
Range.Text returns Null when the individual cell texts in the range are different.
I don’t know dataobject, so I propose a workaround by having the user select the destination cell, too
Private Sub CommandButton1_Click()
Dim userRng As Range
With ActiveSheet 'reference currently active sheet, before the user could change it via inputbox
Set userRange = GetUserRange()
If Not userRange Is Nothing Then ' if the user chose a valid range
With .Range("A32:Q32")
userRange.Resize(.Rows.Count, .Columns.Count).Value =.Value ' paste values only
End With
End If
End With
End Sub
Function GetUserRange() As Range
' adapted from http://spreadsheetpage.com/index.php/tip/pausing_a_macro_to_get_a_user_selected_range/
Prompt = "Select a cell for the output."
Title = "Select a cell"
' Display the Input Box
On Error Resume Next
Set GetUserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Range selection
' Was the Input Box canceled?
If GetUserRange Is Nothing Then MsgBox “Canceled!”
End Function
Hi I’m a nube to excel VBA and would appreciate it greatly if someone could assist me in this issue.
I’ve spent over 5 days researching and reading, trying to solve this issue and can’t get the required result can anyone please help.
I’m using a userform to submit data to a worksheet then the above vba to open a word template, dynamically select the last line of the worksheet and enter selected cell data into a pre-existing table at various placeholder bookmarks within a word template.
The code always pastes the data above the table and not in it.
Here's the code i'm using
Sub testdata()
'declare variables
Dim wdDoc As Word.Document
Dim wdApp As Word.Application
'declare variable for save format
Dim savename As String
'declare fileext type for differnt versions of word
Dim fileext As String
'start word
Set wdApp = New Word.Application
'make it visible and activate it
With wdApp
'uncomment 2 lines below to see word on screen
.Visible = True
.Activate
'opens a word doc
.Documents.Add "C:\xxx\xxx\excel_project\test.docx"
'collect data range ref number
Range("A1").End(xlDown).Copy
'selects the item bookmark in word template
.Selection.GoTo What:=-1, Name:="Item"
'paste into word doc
.Selection.Paste
'test version type of word
If .Version <= 11 Then
fileext = ".doc"
Else
fileext = ".docx"
End If
'saves doc with specific timedate name
savename = "C:\xxx\xxx\excel_project\test" & _
Format(Now, "dd-mm-yyyy hh-mm-ss") & fileext
'changes save as method depended on word version
If .Version <= 12 Then
.ActiveDocument.SaveAs savename
Else
.ActiveDocument.SaveAs2 savename
End If
'closes the doc
.ActiveDocument.Close
'closes word
.Quit
End With
End Sub
One source of help suggested using
`
Sub FnBookMarkInsertAfter()
Dim objWord
Dim objDoc
Dim objRange
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\xxx\xxx\excel_project\test.docx")
objWord.Visible = True
Set objRange = objDoc.Bookmarks("item").Range
objRange.InsertAfter ("..........I will be added AFTER bookmark")
End Sub
`
This places the string of text into the table and I can’t find a way to make it dynamically select the last row and hence the required data.
Any help would be greatly appreciated
This code inserts an extra row below the last row of a table. The bookmark "Item" must be located inside your table, then this will work. The strings col1 and col2 are inserted in the cells of the new row. Hope this helps you.
Sub InsertTextAtEndOfTable()
Application.ScreenUpdating = False
Dim col1, col2 As String
col1 = "TitleColContent"
col2 = "ValueColContent"
Selection.GoTo What:=wdGoToBookmark, Name:="Item"
Dim tabSize As Integer
tabSize = Selection.Tables(1).Rows.Count
Selection.Tables(1).Cell(1, 1).Select
Dim i As Integer
For i = 1 To tabSize - 1
Selection.MoveDown Unit:=wdLine, Count:=1
Next i
Selection.InsertRowsBelow
Selection.TypeText col1
Selection.MoveRight
Selection.TypeText col2
Application.ScreenUpdating = True
End Sub
I'm trying to copy the values from a named range in Excel to a bookmark in Word. I found this code on the web that does it in Excel VBA, but I'm getting an Error 13.
Set pappWord = CreateObject("Word.Application")
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
I know that the line that is causing the error is:
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
What am i doing wrong? Also, how & where would I code so that I can export the doc to PDF?
Thanks in advance.
Note: I've already selected the reference to the Microsoft Word (version number 14) Object model in Excel
so I use it to accomplish this task but taking an image from formatted Excel table.
Sub FromExcelToWord()
Dim rg As Range
For Each xlName In wb.Names
If docWord.Bookmarks.Exists(xlName.Name) Then
Set rg = Range(xlName.Value)
rg.Copy
docWord.ActiveWindow.Selection.Goto what:=-1, Name:=xlName.Name
docWord.ActiveWindow.Selection.PasteSpecial link:=False, DataType:=wdPasteEnhancedMetafile, Placement:= _
0, DisplayAsIcon:=False
End If
Next xlName
End Sub
Just curious... Why are you adding a document rather than opening the relevant doc which has the bookmarks? Try this code (I usually test the code before posting but I haven't tested this particular code. Just quickly wrote it)
Also I am using Late Binding so no reference to the Word Object Library is required.
Sub Sample()
Dim wb As Workbook
Dim pappWord As Object, docWord As Object
Dim FlName As String
Dim xlName As Name
FlName = "C:\MyDoc.Doc" '<~~ Name of the file which has bookmarks
'~~> Establish an Word application object
On Error Resume Next
Set pappWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set pappWord = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
Set docWord = pappWord.Documents.Open(FlName)
Set wb = ActiveWorkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Value
End If
Next xlName
'Activate word and display document
With pappWord
.Visible = True
.ActiveWindow.WindowState = 0
.Activate
End With
End Sub
EDIT
Changed
Range(xlName.Value)
to
Range(xlName).Value
Now the above code is TRIED AND TESTED :)
I've looked at the documentation for table cell objects and selection objects in VBA, and I didn't see any way to delete cell contents in Word while retaining the cell itself. It looks like doing so is easy in Excel, and next to impossible in Word.
Some cells I need to do this for will contain text, others will contain text form fields. Any ideas?
This works:
ActiveDocument.Tables(1).Cell(1, 2).Select
Selection.Delete
This deletes the cell contents but leaves the empty cell behind.
I understand your dismay, because oddly, the above does not do the same as
ActiveDocument.Tables(1).Cell(1, 2).Delete
which deletes the entire cell!
The former is the equivalent of selecting a cell and pressing the Delete key (which clears the contents but leaves the cell in place). The latter is the equivalent of right-clicking a cell and choosing "Delete cells..." (which deletes the cell).
I cobbled this together from various parts of the interwebs... including Fumei from VBA Express. It's working well. Select any cells in your table and run the macro deleteTableCells
Sub deleteTableCells()
Dim selectedRange As Range
On Error GoTo Errorhandler
Set selectedRange = SelectionInfo
selectedRange.Delete
Errorhandler:
Exit Sub
End Sub
Function SelectionInfo() As Range
'
Dim iSelectionRowEnd As Integer
Dim iSelectionRowStart As Integer
Dim iSelectionColumnEnd As Integer
Dim iSelectionColumnStart As Integer
Dim lngStart As Long
Dim lngEnd As Long
' Check if Selection IS in a table
' if not, exit Sub after message
If Selection.Information(wdWithInTable) = False Then
Err.Raise (2022)
Else
lngStart = Selection.Range.Start
lngEnd = Selection.Range.End
' get the numbers for the END of the selection range
iSelectionRowEnd = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnEnd = Selection.Information(wdEndOfRangeColumnNumber)
' collapse the selection range
Selection.Collapse Direction:=wdCollapseStart
' get the numbers for the END of the selection range
' now of course the START of the previous selection
iSelectionRowStart = Selection.Information(wdEndOfRangeRowNumber)
iSelectionColumnStart = Selection.Information(wdEndOfRangeColumnNumber)
' RESELECT the same range
Selection.MoveEnd Unit:=wdCharacter, Count:=lngEnd - lngStart
' set the range of cells for consumption
With ActiveDocument
Set SelectionInfo = .Range(Start:=.Tables(1).cell(iSelectionRowStart, iSelectionColumnStart).Range.Start, _
End:=.Tables(1).cell(iSelectionRowEnd, iSelectionColumnEnd).Range.End)
End With
End If
End Function
Sorry for digging up such an old question, but hopefully someone will find this useful. If you prefer to avoid the Select method, the following is what you're looking for:
ActiveDocument.Tables(1).Cell(1, 1).Range.Text = ""
It deletes images and content controls as well.
Private Sub cbClearTable_Click()
'mouse cursor must be in the table for clearing
Dim cell_BhBp As Cell
For Each cell_BhBp In Selection.Tables(1).Range.Cells
cell_BhBp.Range = ""
Next
End Sub
The code above clears the contents in all cells in the current table /the table, where the mouse cursor is/
One other way to clear all table cells of first table in document is
ActiveDocument.Tables(1).Range.Delete
Or for current table /where the cursor is in/
Selection.Tables(1).Range.Delete
Private Sub CommandButton40_Click()
Application.Activate
SendKeys ("{DEL}")
End Sub
The code above clears contents of all selected cells. In this case, the selected cells may not be adjacent. This code is fired when button of user form is clicked.