I have code that opens a Word document and goes through the charts, updating the data.
The problem is that I call this macro multiple times in a row. Even though I close the Word application, the chartdata window remains open.
Excel is crashing without telling me why but E think the problem is with the chartdata windows not being closed. Because if I run the macro only one time, it works.
But, how do I close the chartdata window if the chart doesn't support this property?
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdShape As InlineShape
Dim wdChart As Word.Chart
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
'Opening the document
Set wdDoc = wdApp.Documents.Open("path_here")
'Opening the chartdata window
Set wdShape = wdDoc.InlineShapes(1)
Set wdChart = wdShape.Chart
wdChart.ChartData.Activate
'Changing the data
Range("B2").Value = 120
Range("B3").Value = 155
'Closing the app
wdApp.Quit SaveChanges:=wdSaveChanges
Set wdShape = Nothing
Set wdChart = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
This code will change the values in the data without activating the chartdata window. For some reason the wdChart variable was throwing a constant assignment error, so I changed it to wdCh.
Set wdShape = wdDoc.InlineShapes(1)
Set wdCh = wdShape.Chart
With wdCh.ChartData.Workbook.Sheets(1)
.Range("B2").Value = 120
.Range("B3").Value = 155
End With
Related
I've set up code that opens a word document and closes excel, from the word document there is code to reopen excel and copy user data to a new sheet which I pull from for a form. This whole process works perfectly, the issue is trying to close the word document once I've finished my tasks.
I want to close the word document once I'm back in excel however everything I'm trying returns bad file name error when I try to reference the doc. I know for a fact that the file path is correct. I also know that you cant reference the open doc the normal way you would. I've substituted the variable filePath for privacy reasons.
Here is the code from word which is executed first
Sub sendTableToExcel()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim ws As Worksheet
Dim doc As Document
Dim tbl As Table
Set doc = ThisDocument
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWb = xlApp.Workbooks.Open(filePath)
Set ws = Sheets.Add
ws.Name = "temp"
Set tbl = doc.Tables(1)
tbl.Range.Copy
xlWb.Worksheets(ws.Name).PasteSpecial wdPasteText
ws.Visible = False
xlWb.Application.Run "pasteCopiedValuesFromRequestDocs"
xlWb.Application.Run "openRequestLanding", "Casual" //this is the where I'm trying to close the doc
Set xlWb = Nothing
Set xlApp = Nothing
Set tblRange = Nothing
Set tbl = Nothing
Set doc = Nothing
End Sub
and the sub from excel which is called from word
Public Sub openRequestLanding(requestType As String)
Dim wdApp As Word.Application
Dim doc As Word.Document
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set doc = wdApp.Documents(filePath)
doc.Close SaveChanges:=wdDoNotSaveChanges
Set wdApp = Nothing
Set doc = Nothing
RequestLanding.RequestTypeBox.Value = requestType
RequestLanding.Show
End Sub
You will have no success in closing the document as it is not open in the instance of Word that your code references. Your code in Excel needs to get the currently open instance of Word, not create a new one.
Change
Set wdApp = CreateObject("Word.Application")
to
Set wdApp = GetObject(, "Word.Application")
I'm trying to copy all inline shapes from a word document to excel sheet.
The Word Document has multiple pages, with multiple tables with images in them.
The code I'm using is:
Sub imageExtract()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim shpCurr As InlineShape
Dim i As Long
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("C:\Temp\01.docx")
For Each shpCurr In wrdDoc.InlineShapes
shpCurr.Range.CopyAsPicture
Sheet10.Range("A" & i).PasteSpecial
i = i + 1
Next shpCurr
End Sub
Can someone explain to me why it is working for all the shapes in the first page of the Word document, and doesn't work for the shapes from another pages?
wrdDoc.InlineShapes.Count shows the real number of the shapes in the doc, so the loop is compleate
I've tried to cut and paste each shape to the first page before .CopyAsImage, with no sucsess.
I also tried to loop through each table and reference to the table's inline shapes ( "wrdDoc.tbl.InlineShapes"), with no sucsess.
If I manualy move a picture from (let's say) Page2 to Page1 and run the code again, this picture is copied.
If the problem is not the initial setting of the variable i, as I have mentioned in my comment above, then maybe you should try this code because not all shapes in a Word document are necessarily InlineShapes. The definition of InlineShapes in Word is they reside on their own paragraph. The other possibility for Shapes in a Word document are they have wrapping text and are anchored to some other place in the document. The significance here for InlineShapes and Floating Shapes is they each have to be referenced separately.
Of course you have mentioned that the InlineShapes count matches to what you expect but ... who knows ... maybe try this:
Sub imageExtract()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim iShp As Word.InlineShape, shp As Word.Shape
Dim i As Long
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open("C:\Temp\01.docx")
If wrdDoc.Shapes.Count > 0 Then
For i = 1 To wrdDoc.Shapes.Count
Set shp = wrdDoc.Shapes(i)
shp.ConvertToInlineShape
Next
End If
If wrdDoc.InlineShapes.Count > 0 Then
For i = 1 To wrdDoc.InlineShapes.Count
Set iShp = wrdDoc.InlineShapes(i)
iShp.Range.CopyAsPicture
Sheet10.Range("A" & i).PasteSpecial
Next
End If
End Sub
UPDATE
After you sent me the files I was able to figure out that the problem is with Excel's PasteSpecial and if executed too many times an error 1004 PasteSpecial method of Range class failed because for some unknown reason something clears the clipboard and attempting to paste an empty clipboard generates the error.
I altered your code to use Word's Selection method to copy the images versus a Range method that was in your original code and that took care of the problem ... strange but it works. I also added some other code so that Word is properly closed out when the routine ends.
Sub imageExtract()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim shpCurr As Word.InlineShape
Dim i As Long
On Error GoTo errHandler
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(ThisWorkbook.Path & "\01.docx")
i = 1
wrdDoc.Activate
Debug.Print wrdDoc.InlineShapes.Count
'On Error Resume Next
For Each shpCurr In wrdDoc.InlineShapes
shpCurr.Select
wrdApp.Selection.CopyAsPicture
Sheet10.Range("A" & i).PasteSpecial xlPasteAll
i = i + 1
Next
'the following is copying only one character which will clear the clipboard
'and prevent the message about wanting to save the last thing copied
wrdApp.Selection.EndKey wdStory
wrdApp.Selection.MoveStart wdCharacter, -1
wrdApp.Selection.Copy
wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing
MsgBox "Complete"
Exit Sub
errHandler:
MsgBox Err.Number & Chr(32) & Err.Description, vbCritical
wrdDoc.Close SaveChanges:=wdDoNotSaveChanges
wrdApp.Quit
Set wrdApp = Nothing
End Sub
I want to create Excel VBA code that asks the user to open a pre-existing Word document with text form fields and input existing Excel data in these form fields.
I have code that writes the Excel data into the Word text form field.
Sub NewMacro()
Dim wdApp As Object, wd As Object, ac As Long, ws As Worksheet
Set ws = Sheets("Tables")
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Open("C:\Test\Test.docx")
wdApp.Visible = True
With wd
.FormFields("CustomerName").Result = ws.Range("D4").Value
End With
Set wd = Nothing
Set wdApp = Nothing
End Sub
I am lost as to converting the Set wd= wdApp.Documents.Open("FilePath") line into a dialog box.
Does a function exist where the user can select the file by clicking through Windows Explorer as opposed to typing the path?
Do you want the user to input the name of a Word file? Do you want the InputBox method?
Dim strWord As String
strWord = InputBox(prompt:="Type the file path and name of the Word file.", title:="Which file?", default:="C:\Path\File.docx")
Set wd = wdApp.Documents.Open(strWord)
Tell me if I didn't understand your question.
When I open Workbook and run this code everything is fine. Also if I close Workbook and open it again and run this code everything if functioning. However if I open Workbook and try to run this code for the second time then all Word operations are crushing. Word template is opened by code and even is saved to needed destination but it is not able to close Word document and gives an error:
Is there some variable or something in Windows memory still present after code has been executed because after closing and reopening Workbook everything works fine. Any ideas how to fix this?
Sub opentemplateWordOL()
Dim sh As Shape
Dim objWord As Object, objNewDoc As Object ''Word.Document
Dim objOL As OLEObject
Dim wSystem As Worksheet
'Application.ScreenUpdating = False
Set wSystem = ThisWorkbook.Sheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("OfferLetterTemplate")
''The OLE Object contained
Set objOL = sh.OLEFormat.Object
'Instead of activating in-place, open in Word
objOL.Verb xlOpen
'Set objWord = objOL.Object 'The Word document
Set objNewDoc = objOL.Object
Set objWord = objNewDoc.Application
Dim objUndo As Object 'Word.UndoRecord
'Be able to undo all editing performed by the macro in one step
Set objUndo = objWord.UndoRecord
objUndo.StartCustomRecord "Edit In Word"
With objNewDoc
'Cover page
.Bookmarks("CoverPageTitle").Range.Text = ThisWorkbook.Sheets("Sheet1").Range("B2").Value
objNewDoc.SaveAs2 Environ$("Temp") & "\" & _
"MyFile" & ".docx"
objUndo.EndCustomRecord
objNewDoc.Undo
.Application.Quit False
End With
Set objWord = Nothing
Set objUndo = Nothing
Set sh = Nothing
Set wSystem = Nothing
Set objNewDoc = Nothing
'Application.ScreenUpdating = True
End Sub
You can check how this behaves on my computer here: https://streamable.com/2xd8k
You can see (by time of creation of file) that it is getting overwritten every time even when there is an error.
I am importing data from Outlook. The code for opening Excel opens an instance where personal.xlsb is not loaded, and will open multiple instances of Excel. If I run it twice it will open two instances but will overwrite the data in the first instance, leaving the second instance with a blank workbook. If Excel is closed and Outlook is not, then the code is run it will give an error since it won't put the data into the new "second" instance, even though only one instance is running.
Sub Extract()
On Error GoTo 0
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim ThermoMail As Outlook.MailItem
Set ThermoMail = Application.ActiveInspector.CurrentItem
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add
'Set Headings
Dim msgText, delimtedMessage, Delim1 As String
delimtedMessage = ThermoMail.Body
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'this next line gives the error if excel is closed and the macro is rerun.
Range("A1:A" & UBound(messageArray) + 1) = WorksheetFunction.Transpose(messageArray)
Call splitAtColons
End Sub
Right now, you are creating a new instance of Excel with this line:
Set xlobj = CreateObject("excel.application")
Excel is different than some (most) Office Applications, because it can run multiple instances (PowerPoint, Outlook, Word cannot do this...)
So what you want to do is first check if there is an open instance of Excel, and use that. Only create a new instance if there is no instance already open.
On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj Is Nothing Then Set xlObj = CreateObject("Excel.Application")