I have big presentation (~300 slides) And i need to make few versions of it, each connected to diffrent excel file. I have code that changes links for all shapes inside prestations. Its all good for charts, but there is problem with linked tables. Source change is correct, but during this change range for table dissapires (range is set for 1st sheet cell A1).
Is there way to keep the range unchanged?
Additional question: changing chart source is very fast (<1s),whereas changing linked table source takes some time (~15s). This becomes a problem where there is a lot tables.
When i run code few times ~50 slides in one run it went well (took ~5-10min), but when i tried run it on all ~300 slides i waited for 30min and it didn't finish (there was no crush, it looked like procedure frozed). Im really curious why this problem occures.
Belowe code i use for link change:
Sub UpdateLinks()
Dim ExcelFile
Dim exl As Object
Set exl = CreateObject("Excel.Application")
'Open a dialog box to promt for the new source file.
ExcelFile = exl.Application.GetOpenFilename(, , "Select Excel File")
Dim i As Integer
Dim k As Integer
'Go through every slide
For i = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(i)
'Go through every shape on every slide
For k = 1 To .Shapes.Count
'Turn of error checking s that it doesn 't crash if the current shape doesn't already have a link
On Error Resume Next
'Set the source to be the same as teh file chosen in the opening dialog box
.Shapes(k).LinkFormat.SourceFullName = ExcelFile
If .Shapes(k).LinkFormat.SourceFullName = ExcelFile Then
'If the change was successful then also set it to update automatically
.Shapes(k).LinkFormat.AutoUpdate = ppUpdateOptionAutomatic 'other option is ppUpdateOptionManual/ppUpdateOptionAutomatic
End If
On Error GoTo 0
Next k
End With
Next i
End Sub
All tips are welcome! :)
Have you looked at what .SourceFullName returns? Usually it's not just the file name but also further code that indicates what sheet and range within the sheet the link points to. It looks like you're changing that to just the name of the replacement Excel file.
Instead, try using Replace to substitute the name of the new Excel file for the name of the old Excel file in .SourceFullName. That'll leave the rest of the link text intact.
Related
What I have:
An Excel file where in a column (actually it is free formatted but aligned to be within a column) some elements are embedded bmp pictures that show the formula =EMBED("Paint.Picture","") when you click on them. When you look at the Excel sheet, only the icon representing the picture is displayed, not the picture itself.
What I want:
The embedded picture (not the icon) copied to a new Word document.
The Code I have thus far:
'Image Objects
Dim myObjs As Shapes
Dim myObj As Shape
Set myObjs = ActiveSheet.Shapes
'Traversing objects
Dim row As Integer
Dim myRange As Range
Dim myRange2 As Range
Dim isAddressMatch As Boolean
'Word Document Objects
Dim wordApp As New Word.Application
Dim myWord As Word.Document
'Prepare word for output
Set myWord = wordApp.Documents.Add
wordApp.Visible = True
'Initalize traversing objectts
Set myRange = Sheets("myWorksheet").Range("Q5")
Set myRange2 = Sheets("myWorksheet").Range("E5")
row = 0
'Loop through range values in the desired column
While (myRange2.Offset(row).Value <> "")
'Loop through all shape objects until address match is found.
For Each myObj In myObjs
On Error Resume Next
isAddressMatch = (myObj.TopLeftCell.Address = myRange.Offset(row).Address)
If Err.Number <> 0 Then
isAddressMatch = False
On Error GoTo 0
End If
'When match is found copy the bmp picture from Excel to Word
If (isAddressMatch) Then
myObj.Select
''''''''This copies the excel default picture,'''''''''''''''
''''''''not the picture that is embeded.'''''''''''''''''''''
myObj.CopyPicture 'What is the correct way to copy myObj
myWord.Range.Paste
'Rest of the code not yet implement
End If
Next
row = row + 1
Wend
What happens when I run my code:
My code goes through all "shapes" that are within the bounds of the column and copies that objects picture. However, when I paste it into word, it literally made a copy of the link image (icon), and not the underlying embedded image.
What I've found thus far:
This code which shows me how to create an embedded object, but not how to copy one.
Update: Simpler solution
As specified in the comments by jspek, the image can actually be copied by using the Copy method of the OLEObject, e.g.:
Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)
'Copy the OLE object representing a picture.
obj.Copy
'Paste the picture in Word.
myWord.Range.Paste
Old solution
I've found a suboptimal solution that involves both the clipboard and SendKeys - inspired by this link. I'm quite convinced that you can do this more elegantly by exploring ways to extract the OLEObject's properties. Extracting these is beyond the scope of my expertise at this time of writing :-)
It revolves around OLEObject. This code executes the OLE object's host application (which is Paint in this case) of your picture, sends keys to copy the picture and finally, pastes it into Word.
'Get the OLE object matching the shape name.
Dim obj As OLEObject
Set obj = ActiveSheet.OLEObjects(myObj.Name)
'Activate the OLE host application.
obj.Activate
'Send CTRL+A to select the picture in Paint and CTRL+C to copy it.
Application.SendKeys "^a"
Application.SendKeys "^c"
'Paste the picture in Word.
myWord.Range.Paste
I am not a coder, but I found that if you "Define Name" for a cell range, you can do all kinds of things with the defined names. For example:
Linking Excel Workbook rows to a Word document
1. Open your Excel work book go to Formulas -> Define NAME
2. Create a "NAME" for each of the cells or groups of cells that you would like to link.
For example, I hyper-linked a Question # in a Word document to my Excel document that is used for importing questions into our Learning Management System. Example NAME = Question_22 and refers to cell range =WBT16DS058!$A$90 (=worksheet!cellrange)
3. Save & close Excel workbook.
4. Open the Word document and create your text (Question 022) , highlight and insert a hyperlink.
5. Browse & Select your Excel document, append the end of the address to include #NAME. (i.e. - R312Test.xlsx#Question_22).
6. Select the new link, and your Excel document will open to the cell range.
Because you are defining a NAME for the range of cells, the link will stay active even when the cells are moved around.
I am wondering if you used "Define Name" for your cell range that includes the picture you are trying to embed, you will have luck.
My apologies if you have already defined the cell range's name and tried this.
I am using a macro to populate a word document with text from named ranges in excel. The word document has bookmarks that correspond with the named excel ranges. I did not write the code, but rather copied it from another source.
There is quite a bit more to this macro than the snippet I posted. I could post the rest if that is useful. I had about half of my word document bookmarked and the macro was working fine then it suddenly stopped working.
I am receiving a error 1004 in the line highlighted below. I am a newbie so I'm not even quite sure what I should be searching for to fix this issue. Any assistance you could provide would be appreciated! Thanks in advance!
P.S. In case it's relevant, I am using Word and Excel 2007
'PASTE TEXT STRINGS LOOP
n = 1
For Each temp In BkmTxt
p = p + 1
Prompt = "Please wait. Copying text. Carrying out operation " & p & " of " & pcount & "."
Application.StatusBar = Prompt
'If The Bkmtxt(n) is empty then go to the next one, once that has been found do next operation.
If BkmTxt(n) = Empty Then
n = n + 1
'should find match and work
Else
'You might want to use multiple copies of the same text string.
'In this case you need to call the bookmark as follows: "ARTextWhatever_01"
'You can use as many bookmarks as you want.
BkmTxtSplit = Split(BkmTxt(n), "_")
vValue = Range(BkmTxtSplit(0)).Text **<----- ERROR HERE**
Set wdRng = wdApp.ActiveDocument.Bookmarks(BkmTxt(n)).Range
If Len(sFormat) = 0 Then
'replace the bookmark text
wdRng.Text = vValue
Else
'replace the bookmark text with formatted text
wdRng.Text = Format(vValue, sFormat)
End If
'Re-add the Bookmark
wdRng.Bookmarks.Add BkmTxt(n), wdRng
n = n + 1
End If
Next
Step 1: Don't copy code from external sources. Use external sources as a learning tool and try to understand what they are actually doing.
Now if I understand you correctly, you simply have an Excel sheet with named ranges, I assume they have information already within them, and a word document with bookmarks that EXACTLY match the named ranges:
Step 2: Make sure you have the word object library reference within excel
Here:
sub KeepItDoin()
dim xlRange as Excel.Range
dim wdApp as new Word.Application
dim wdDoc as Word.Document
dim wdBkm as Word.Bookmark
set wdDoc = wdApp.Documents.Open( "Filepath" ) 'get filepath from where ever
for each wdBkm in wdDoc.Bookmarks
set xlRange = Application.Range(wdBkm.Name)
wdBkm.range.text = xlRange.Value
next wdBkm
end sub
That will get you close probably (didn't test, don't care if it works. Use it to learn). The idea is that if the bookmarks match up to the range, we can use their names to find the ranges in excel and then tell excel to move the data within it into the bookmarks range.
You will likely need to add some formatting or maybe create a table and then move cell by cell in the range and fill the table but this is as close as I'm willing to get since you like to copy pasta.
In case anyone is interested, I figured it out. There was an error with the bookmarks I inserted into my Word document. This macro returns Error 1004 if the word document contains a bookmark that does not correspond to a range in excel. Thank you for your help.
Thanks for your time! Using snippets of code gathered here on stackoverflow and elsewhere, I was able to cobble together a macro that will populate a combobox in Word from a defined range of data in an Excel file, and then get a label to print the second column from the combobox (which is too long to display in the combobox itself). So far, so good. Here's my code:
Private Sub ComboBox1_DropButtonClick()
'Late binding. No reference to Excel Object required.
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim cRows As Long
Dim i As Long
Set xlApp = CreateObject("Excel.Application")
'Open the spreadsheet to get data
Set xlWB = xlApp.Workbooks.Open("EXCEL FILEPATH")
Set xlWS = xlWB.Worksheets(1)
cRows = xlWS.Range("$A2:$B216").Rows.Count - xlWS.Range("$A2:$B216").Row + 1
ComboBox1.ColumnCount = 2
'Populate the listbox.
With Me.ComboBox1
For i = 2 To cRows
'Use .AddItem property to add a new row for each record and populate column 0
.AddItem xlWS.Range("$A1:$B216").Cells(i, 1)
'Use .List method to populate the remaining columns
.List(.ListCount - 1, 1) = xlWS.Range("$A1:$B216").Cells(i, 2)
Next i
End With
'Clean up
Set xlWS = Nothing
Set xlWB = Nothing
xlApp.Quit
'Make label print column 2 of ComboBox
With ComboBox1
Label1.Caption = .List(.ListIndex, 1)
End With
End Sub
The problem is that when the Excel file is moved and then the Word file is closed and reopened, the comobobx no longer gets populated. Unfortunately, this needs to be a standalone Word doc that is distributable via e-mail to multiple users. Is there a way to populate the combobox so the Word document holds the data without having to refer back to the Excel file each time the doc is opened?
Thanks again!
One way to achieve this that I've used before is not to use Excel at all, when you send out the Word document, have it connect to a trusted web site that returns the list instead.
While I've not done this in Word, I have done it with Excel where the spreadsheet was emailed out as a blank template for filling in. A web site was used to populate reference data dropdowns. The reference data changed periodically so that was the best way to provide the freshest data while retaining an existing spreadsheet that people were familiar with.
If you are not too bothered about populating from a spreadsheet, you can of course, create a combo from code, the values for the combo could be kept in a field in Word.
Let me know if either of these is helpful & I will try to expand if needed.
Update:
You can make use of a DocProperty Field to store the entries for your combo if you don't actually need anything else from your spreadsheet.
Create a field called Combo Options or whatever and put into it:
Option 1;Option 2;Another Option
Or whatever text options you want.
In VBA, you can access the fields using:
ActiveDocument.CustomDocumentProperties("Combo Options").Value
Then you can split the field into it's components and iterate over them to add the combo box options.
Why don't you create file in user's computer with desired data? That means, it only requires first time for them to open excel file and afterwards it would read the data from .txt file.
Here is link on how to create simple file in user's computer:
http://www.java2s.com/Code/VBA-Excel-Access-Word/File-Path/WritingtoTextFilesUsingPrint.htm
H ey folks,
I've assembled the following code, which copies the first table in my Word document and inserts it at a bookmark position and also adds a formated heading above it via a second bookmark.
To fully automate my Excel application however, I need an advanced functionality of my code. After an insertion was done, the bookmarks have to be relocated to a position directly above the newly inserted table / heading.
Is it possible to relocate these bookmarks programmatically?
Any help is much appreciated.
Best regards,
daZza
Code:
Sub Main()
Dim doc As Word.document
Set doc = GetObject("xxxx.docx")
doc.Tables(1).Range.Copy
doc.bookmarks("AH_Tab").Range.Paste
doc.bookmarks("AH_Header").Range.Text = "Test"
doc.bookmarks("AH_Header").Range.Style = wdStyleHeading1
End Sub
Add the following code before End Sub
Dim tmpRng As Range
Set tmpRng = doc.Bookmarks("AH_Header").Range
doc.Bookmarks.Add "AH_Header", ActiveDocument.Range(tmpRng.Start - 1, tmpRng.Start - 1)
Additional information:
do the same for second bookmark
by changing -1 values you can expand
& move the range where exactly the new bookmark should be placed
Background:
Every month I need to run a report. However, before I can do this, I must export some data in to excel. Once the data is in excel, I have to alter some columns and get the format correct before it is appended to the end of another document to do some analysis on.
What I would like:
I would like to have the document that I append the data to open. I will then export the data in to excel from my program (excel just opens with the data and it is not saved anywhere) and from my larger document, run a VBA script that will alter the data on the other workbook (Book1) so that it can be copied over to the analysis document when in the correct format.
What I have so far:
I have started basic. So far all I am trying to do is set all the cells to the correct height to make it easier to read. However, when I run this code, I get:
Run-time error '9':
Subscript out of range
The code I have so far is:
Sub Data_Ready_For_Transfer()
' Format all cell heights to 15
With Workbooks("Book1.xlsm").Worksheets("Sheet1")
Cells.RowHeight = 15
End With
End Sub
It appears to be having issues with the With Workbooks("Book1.xlsm").Worksheets("Sheet1") part of the code. I have also tried With Workbooks("Book1").Worksheets("Sheet1") and I have tried this with the open, unsaved document and a saved version of the workbook.
Am I missing something obvious?
As follow up from comments, workbook Book1 was opened in another instance of Application object.
In that case this code should work (for already opened workbook):
Sub Data_Ready_For_Transfer()
Dim wb As Workbook
Set wb = GetObject("Book1")
'if we get workbook instance then
If Not wb Is Nothing Then
With wb.Worksheets("Sheet1")
.Cells.RowHeight = 15
End With
End If
End Sub
One more issue, I've changed Cells.RowHeight = 15 to .Cells.RowHeight = 15 to specify, that Cells belongs to workbook Book1 sheet Sheet1.