I'm creating an Excel document that, among other things, copies a few arrays of data into a Word file.
Everything is working absolutely fine except that, when it pastes the selection I'm interested in, it pastes it infinitely until I intervene by taking down Word via Task Manager.
There is no reason, as far as I can see, for it to loop. So I'm pretty clueless of what to do next, and I was hoping you guys would shed a light into what I'm doing wrong. The concept is as follows:
Sub TestA()
'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range
'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
'Opening app and document
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open("C:\Users\RCO1\Desktop\Teste VBA\2. Conceptual Testing\Export\XLWDTST.docx")
Set wdbmRange = wdDoc.Bookmarks("TableInsertion").Range
'Selecting array
Sheets("ExportMe").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pasting data
With wdbmRange
.PasteSpecial '<------- it simply goes back up to the beginning of the code at this point
CutCopyMode = False
End With
'Closing and saving
wdDoc.Save
wdDoc.Close
wdApp.Quit
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
Just note that I can't simply transform this array into a table so to speak for formatting reasons.
After placing a few inquiries, I have been given the following simple, yet very effective, piece of code:
Set wdApp = CreateObject("Word.Application")
Filepath = Sheets("Proposal Generator").Range("I9")
Set wdDoc = Word.Documents.Open(Filepath)
with wdDoc
Sheets("Shhet1").Cells(1).CurrentRegion.Copy
.Bookmarks("TableInsertion").Range.PasteExcelTable 0, 0, 0
.SaveAs (TxtSaveFolder.Text & "\" & TxtFileName.Text)
End With
I hope this works for anyone who's trying to export tables.
Related
I am trying to export each worksheet content (textboxes and shapes, no cellcontent) into a word document. The result is not what I expected. If there are 2 worksheets each one with a text box, 1 text box will be copied twice and the other one won't be copied at all!
Private Sub Export()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
Next ws
End Sub
What I am missing:
Insert a page break after each ws is exported
Understanding why a textbox from a worksheet is copied twice and another textbox from a different worksheet is not copied at all
1. Adding page breaks
If you want to insert a page break at the end of your Word file, you can (1) select the end of the Word content section and (2) insert the page break like this:
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Your code would then look like this:
Private Sub Export_v1()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
2. Avoiding the same text box to be pasted
If you run the above macro, you'll still get the textbox(s) from the first sheet twice. Why? Because you are using Selection.Copy which is dependent on which sheet is active.
To make sure that the correct sheet is active, simply add ws.Activate before selecting the shapes like this:
Private Sub Export_v2()
Dim WordApp As Word.Application
Set WordApp = CreateObject("Word.Application")
On Error Resume Next
WordApp.Documents.Add
WordApp.Visible = True
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
ws.Shapes.SelectAll
Selection.Copy
WordApp.Selection.PasteSpecial DataType:=wdPasteShape
Application.CutCopyMode = False
WordApp.Selection.EndKey Unit:=wdStory
WordApp.Selection.InsertBreak
Next ws
End Sub
3. Potential improvements
3.1 Avoid using Select inside Excel
Avoiding using Select in Excel VBA can lead to major speed improvements. However, in this case you can't just replace
ws.Shapes.SelectAll
Selection.Copy
with
ws.Shapes.Copy
as it won't copy the shapes. Instead, you would need to loop through each shape in the worksheet to paste them one by one. This might introduce more complications to your code, so if speed is not an issue, you could keep it as this.
3.2 Reset objects to nothing
To avoid Excel running out of memory, it is a good practice to always reset objects to nothing after you are done using them (at the end of your procedure in this case):
Set WordApp = Nothing
I'm looking to create a spell check macro for protected word documents. I'm more familiar with Excel VBA and I just created a similar project for protected spreadsheets so I attempted to follow the same logic. So far my code copies misspelled words from the office document, into a new excel workbook and then runs spellcheck, but I am having trouble pasting the new value back into the original word document. I can't have this require "adding a reference library" as this will need to be portable and run without end user intervention.
Here is what I have so far:
Sub SpellCheckDoc()
Dim lockedFields As Long
Dim unlockedFields As New Collection
For Each theFields In ActiveDocument.Fields
If theFields.Locked = True Then
lockedFields = lockedFields + 1
Else
unlockedFields.Add theFields
End If
Next theFields
If lockedFields = ActiveDocument.Fields.Count Then Exit Sub
'Word
Dim objWord As Object 'Word.Application
Set objWord = GetObject(, "Word.Application")
'Excel
Dim objExcel As Object, objWB As Object
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
objExcel.Visible = True
Set wb = objExcel.ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
For Each theFields In unlockedFields
If CheckSpelling(theFields.Result.Text) = False Then
theFields.Copy ' Select text from Word Doc
'Paste into new workbook and spellcheck
With ws
.Range("A1").Select
.Paste
.Range("A1").CheckSpelling
.Range("A1").Copy
End With
objWord.theFields.Paste ''' This line doesn't work
End If
Next theFields
End Sub
Change theFields.Result.Text. So you can do .CheckSpelling in Excel, then make theFields.Result.Text = .Range("A1").Text
Dim correctSpelling as String
With ws
.Range("A1").Select
.Paste
.Range("A1").CheckSpelling
correctSpelling = .Range("A1").Text
End With
theFields.Result.Text = correctSpelling
End If
Next theFields
End Sub
My code below scans the provided doc file (sp parameter) and copy over the tables to a sheet named "xxxx" (given in global variable 'shtTableName'.
This code is working perfectly fine when computer is NOT locked. But this code fails to run when screen/computer is locked.
I traced that the issue.. it is with line
sht.Paste Range("A1")
i tried
Acitvesheet.Paste
but it throws same error.
I tried every possible thing in Excel vba but none worked,....
on top of this, when it throws error, it is not captured in ErrWord section, it immediately throws the error to the parent error handler of calling procedure....
I cant understand why screen/computer locking can create such an issue.
Any help would be greatly appreciated.
I am using Windows 10 Version 1808 Build 10730.20348
Thanks
Gaurav
Sub read_word_document(filename As String)
Dim DOC_PATH As String
DOC_PATH = filename
Dim sht As Worksheet
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim i As Long, r As Long, c As Long
Dim rng As Range, t As Word.Table
Dim oData As New DataObject 'object to use the clipboard
Dim bWordDocObjectCreated As Boolean
On Error GoTo ErrWord
bWordDocObjectCreated = False
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(DOC_PATH, ReadOnly:=True)
bWordDocObjectCreated = True 'indicates that object WordDoc has been created and file has been opened
Set sht = Sheets(shtTableName)
Set rng = sht.Range("A1")
For Each t In WordDoc.Tables
sht.Cells.Delete Shift:=-4162
sht.Activate
sht.Range("A1").Select
t.Range.Copy
sht.Paste Range("A1")
'ActiveSheet.Paste
Exit For 'get only first table
Next t
Application.CutCopyMode = False
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take it to the clipboard to empty it
Application.DisplayAlerts = False
WordDoc.Close False
WordApp.Quit
Exit Sub
ErrWord:
If Not UCase(Err.Description) Like "*CORRUPTED*" And bWordDocObjectCreated = True Then
Data.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
Application.CutCopyMode = False
Application.DisplayAlerts = False
WordDoc.Close False
End If
WordApp.Quit
End Sub
I had a similar problem but in excel. The solution that worked for me was adding
Application.ScreenUpdating = False at the beginning of the macro. This may or may not work in your case.
Generally speaking, macros that simulate a user's actions e.g copy/pasting, sending keystrokes, cannot be run when the screen is locked - in my experience.
You may need another application to ensure the screen is unlocked before running the macro, or keep the screen unlocked. I have used Caffeine for this purpose successfully.
I have a Word document that is received periodically that needs to be combined with other data already in Excel as part of a larger output. I can copy and paste the whole document (WholeStory) from Word into Excel, but I want to make this part of the whole Excel output macro. My current code for this portion is below, and it works fine except that it pastes nothing. There is no data to paste when it gets there, so I guess it is either not picking it up to start with or not carrying it over. Looking for assistance with this. Thanks very much!
Sub ImportSectHWord()
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
If wdFileName = False Then Exit Sub
Set objDoc = GetObject(wdFileName)
objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
Selection.Copy
Worksheets("H Import").Select
Range("A1").Select
ActiveSheet.Paste
objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
End Sub
The statement
Selection.Copy
is copying whatever is currently selected in Excel.
To copy the Selection object in Word, use
objWord.Selection.Copy
It is always advisable to qualify what objects you are referring to when using methods and properties, even when VBA provides a default object.
Sub ImportSectHWord()
'It is better to always define constants, even though they will default to zero
' which just happens to be the desired value in this case
Const wdDoNotSaveChanges As Long = 0
Dim objWord As Object
Dim objDoc As Object
Dim wdFileName
Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")
If wdFileName = False Then Exit Sub
Set objDoc = GetObject(wdFileName)
objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy
ActiveWorkbook.Worksheets("H Import").Select
ActiveWorkbook.Worksheets("H Import").Range("A1").Select
ActiveWorkbook.ActiveSheet.Paste
objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
End Sub
I'm trying to copy a series of charts in one sheet to one document in word, but for some reason I only get the latest paste (meaning the last chart on the sheet). I know that the iteration goes through all charts, becausewhen I modofiy the code to print a single word doc for each chart it does so, but I want the charts together, so please help me out
The code:
Sub ChartsToWord()
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim iCht As Integer
Dim Msg As String
Set WDApp = CreateObject("Word.Application")
Set WDDoc = WDApp.Documents.Add
For iCht = 1 To ActiveSheet.ChartObjects.Count
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
WDDoc.Content.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
Placement:=wdInLine, DisplayAsIcon:=False
WDDoc.Content.InsertParagraphAfter
Next
WDDoc.SaveAs ("C:\Users\confidential\Documents\charts.doc")
WDDoc.Close ' close the document
' Clean up
Set WDDoc = Nothing
Set WDApp = Nothing
End Sub
Please replace beginning of PasteSpecial line into:
WDApp.Selection.Range.PasteSpecial ... 'and so on
In your situation you paste chart into whole document instead of current paragraph.
One more suggestion. You could use the following to insert new paragraph:
WDApp.Selection.MoveEnd wdStory
WDApp.Selection.Move