The following VBA code works perfectly in Windows to copy a table from Excel and paste it into a Word template.
On Mac the pasting step doesn't work and makes Excel and Word crash (no error message, just stop responding and I have to force quit).
I have tried using
.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting
instead of
.Selection.PasteExcelTable False, False, False
but I get the same behavior.
If I stop the macro before the last step, and paste manually into Word, it works. The table is correctly copied into the clipboard and I can paste it.
Sub testPasteMac()
Dim wordApp As Object
Dim FName As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Copy the table from Excel
ws.Range("A1:E4").Copy
'Open Word
On Error Resume Next
Set wordApp = GetObject(, "word.Application")
If Err = 429 Then
Set wordApp = CreateObject("word.Application")
Err.Clear
End If
'Display Word application
On Error Resume Next
wordApp.Activate
On Error GoTo 0
'Path to Word template file
FName = ThisWorkbook.Path & Application.PathSeparator & "FileName.dotx"
'Open template as new file
wordApp.Documents.Add Template:=FName
'Paste clipboard into Word document
With wordApp
.Selection.Goto what:=-1, Name:="bookmarkName"
.Selection.PasteExcelTable False, False, False
'.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End Sub
I use Excel for Mac version 16.18
VisualBasic 7.1
Related
I already have a Macro in Excel that pulls through data from specific tables, rows and columns in a specified Word doc and returns it to cells in my Excel s/sheet. I need to make 2 alterations to the code but my knowledge is not advanced enough.
I need to run this code on multiple Word docs in a specified folder, whether it is .doc or a .docx
I need to establish why on some Word docs, the code fails to pull through the data from the Word doc and I get RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'. I tried putting, 'on error resume next', at the start of the module so it keeps on running to the end, in the hope that some text would get pulled through, but still none of the cells in my Excel s/sheet get populated.
Sub ImportFromWord()
On Error Resume Next
'Activate Word Object Library
Dim WordDoc As Word.Document
Set WordApp = CreateObject("word.application") ' Open Word session
WordApp.Visible = False 'keep word invisible
Set WordDoc = WordApp.Documents.Open("C:\Users\brendan.ramsey\OneDrive - Ofcom\Objectives\Brendan's Objectives 2022-23\Licence calls\test 2.docx") ' open Word file
'copy third row of first Word table
WordDoc.Tables(1).Cell(Row:=1, Column:=3).Range.Copy
'paste in Excel
Range("A3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=6).Range.Copy
Range("B3").PasteSpecial xlPasteValues
WordDoc.Tables(4).Cell(Row:=3, Column:=3).Range.Copy
Range("C3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=5).Range.Copy
Range("D3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=7).Range.Copy
Range("E3").PasteSpecial xlPasteValues
WordDoc.Tables(5).Cell(Row:=2, Column:=2).Range.Copy
Range("F3").PasteSpecial xlPasteValues
WordDoc.Close 'close Word doc
WordApp.Quit ' close Word
End Sub
Your code may behave better if you avoid all that copy/paste and transfer the cell contents directly:
Sub ImportFromWord()
Const FLDR_PATH As String = "C:\Temp\Docs\"
Dim WordDoc As Word.Document, WordApp As Word.Application
Dim rw As Range, f
Set rw = ActiveSheet.Rows(3) 'or some other sheet
f = Dir(FLDR_PATH & "*.doc*") 'check for document
Do While Len(f) > 0
If WordApp Is Nothing Then 'open word if not already open
Set WordApp = CreateObject("word.application")
WordApp.Visible = False
End If
With WordApp.Documents.Open(FLDR_PATH & f, ReadOnly:=True) ' open Word file
WordCellToExcel .Tables(1).Cell(Row:=1, Column:=3), rw.Cells(1)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=6), rw.Cells(2)
WordCellToExcel .Tables(4).Cell(Row:=3, Column:=3), rw.Cells(3)
'etc etc
.Close savechanges:=False
End With
Set rw = rw.Offset(1) 'next row down
f = Dir() 'next file, if any
Loop
If Not WordApp Is Nothing Then WordApp.Quit ' close Word if it was opened
End Sub
'transfer content from a cell in a Word Table to an Excel range
Sub WordCellToExcel(wdCell As Word.Cell, destCell As Range)
Dim v
v = wdCell.Range.Text
destCell.Value = Left(v, Len(v) - 2) 'remove "end of cell" marker
End Sub
RUN TIME ERROR CODE '4605' 'The method or property is not available because no text is selected'.
Runtime Code 4605 happens when Microsoft Word fails or crashes whilst it's running. It doesn't necessarily mean that the code was corrupt in some way, but just that it did not work during its run-time. This kind of error will appear as an annoying notification on your screen unless handled and corrected. Here are symptoms, causes and ways to troubleshoot the problem.
As the error message says there is no text selected. To find out what property or method gives the error message I'd recommend breaking the chain of calls in the single line of code by declaring each property or method call on a separate line, so you will know which call fails exactly.
Here is an abbreviated copy of the code. I put a note in by the line that sometimes will generate an error 424.
Sub Continue()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim SalesPer As Range
On Error GoTo ErrorTrap2
Set wdApp = CreateObject("Word.Application") 'Create an instance of word
Set wdDoc = wdApp.Documents.Open(DocDirectory & "SpartanQuote.docx", ReadOnly:=True) 'Open word file
Range("DataRange").Select
Selection.Copy
wdApp.Selection.Paste 'Sometimes I'll get error 424 on this line, but not always
'Reset variables
Set wdDoc = Nothing
Set wdApp = Nothing
Application.CutCopyMode = False
Range("ModelSelected").Select
Application.ScreenUpdating = True
Exit Sub
ErrorTrap2:
MsgBox "FATAL ERROR. Sorry. A fatal error occured. Error number: " & Str(Err.Number)
wdApp.Visible = True
Set wdDoc = Nothing
Set wdApp = Nothing
Application.ScreenUpdating = True
End Sub
To access the Selection object you are using the Word Application instance in the code:
wdApp.Selection.Paste 'Sometimes I'll get error 424 on this line, but not always
'Reset variables
Instead, you may try using the document to get the selection object or any range in the document and then try to call the Paste method there. See Working with the Selection Object for possible scenarious.
With an already-opened workbook, I want to create a copy of a worksheet ("Template") and re-name it with the value I have in an array. When I debug the code the copy is created when I execute the line but I still get an error 424: object required.
I've tried On Error Resume Next but since I already used On Error GoTo in my sub it isn't read.
Dim oXL As Excel.Application 'Requires loading "Microsoft Excel 16.0 Object Library" from Tools -> References
Dim oWB As Excel.Workbook
Set oXL = New Excel.Application
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn) 'Opens Excel
oXL.Visible = True 'Shows Excel window while running code. Set to false after finished editing.
Dim ws As Worksheet
For i = LBound(seller_names) To UBound(seller_names)
'On Error Resume Next 'Doesn't work
Set ws = oXL.ActiveWorkbook.Sheets("Template").Copy(After:= _
oXL.ActiveWorkbook.Sheets(oXL.ActiveWorkbook.Sheets.Count))
ws.name = seller_names(i)
Next i
Sheets.Copy doesn't return a reference to the copied sheet, so you need to first copy the sheet, then get a reference to it:
With oXL.ActiveWorkbook
.Sheets("Template").Copy After:= .Sheets(.Sheets.Count)
Set ws = .Sheets(.Sheets.Count)) '<< get the copy
ws.name = seller_names(i)
End With
On Error Resume Next should always work - but is not always a good solution - unless you have "Break on all errors" enabled in your VBA Options.
Does anyone know what VBA script i should write to save a word document which was created from a VBA excel script?
Here is my script so far but i would like to add a step to save the produced word document into a certain directory with the naming convention referencing a single cell in my excel sheet
Sub Export_to_word()
'Export Return
Dim wdApp As Object
Dim wd As Object
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.Add
wdApp.Visible = True
Sheets("PM Performance Return").Select
Range("M1:P200").Select
Selection.Copy
wdApp.Selection.PasteExcelTable False, False, False
wd.SaveAs Filename:="Investment Return Period Data", FileFormat:=wdformatdocm
WordTable.AutoFitBehavior (wdAutoFitWindow)
End Sub
I have added a picture for your reference:
try below
wd.SaveAs Filename:=Worksheets("Data").Range("B2").Value & "Investment Return Period Data", FileFormat:=wdformatdocm
In the above statement folder path is at cell B2 of sheet "Data". You may change it as per your scenario. Also make sure the folder path ends with "\" e.g. C:\mukul.varshney\Delete\
I am attempting to export a query based on two combo boxes to excel. Two weeks ago, this code worked. I have moved the database, and updated the code. Now, when I run it, it will open the query, and open excel, but it will NOT rewrite the excel file. It just opens up the old data.
Access 2010
Code:
Private Sub Command14_Click()
DoCmd.OpenQuery "rtnbymonth_qry", acViewNormal, acEdit
DoCmd.OutputTo acOutputQuery, "rtnbymonth_qry", acFormatXLS, "S:\Sales & Use Tax\2016\export.xls"
DoCmd.Close acQuery, "rtnbymonth_qry", acSaveNo
'Open Excel
Call OpenSpecific_xlFile
End Sub
Also here is the code for the program to open excel:
'mini program to open excel
Sub OpenSpecific_xlFile()
' Late Binding (Needs no reference set)
Dim oXL As Object
Dim oExcel As Object
Dim sFullPath As String
Dim sPath As String
' Create a new Excel instance
Set oXL = CreateObject("Excel.Application")
' Only XL 97 supports UserControl Property
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0
' Full path of excel file to open
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "\export.xls"
' Open it
With oXL
.Visible = True
.Workbooks.Open (sFullPath)
End With
ErrExit:
Set oXL = Nothing
Exit Sub
ErrHandle:
oXL.Visible = False
MsgBox Err.Description
GoTo ErrExit
End Sub
Turns out that the location I was saving it to is different than the location where the database is stored. The correct file was saved, just not in the location I was opening it. Easy fix! Programmer error.