I have been creating a macro in excel that will pull information from an excel sheet and insert into a word document.
After much trial and error I have managed to get it to insert all the information I want but I am now stuck on changing the formatting of what is inserted.
After trying a number of different ways to change the formatting inside the macro (none of which worked) I settled on creating a number of functions in word VBA to make the formatting changes I wanted (I.E Change to a style, bold or format to bullet points). These functions work in word with zero problems. But whenever I call them from the excel macro I get a Run-time error '438' Object doesn't support this property or method. I double and triple checked I have the word object library ticked, at this stage I'm assuming I'm doing something an excel object doesn't like but for the life of me I can not figure out where the issues is.
Here is a small section of the excel macro, if I run it without calling the word function it works fine. I have tried putting the call inside a with wrdApp with no luck. I also tried pulling it outside of the with wrdDoc but that didn't work either.
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = CreateWord
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
Call wrdApp.cntrl("Internal Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
Here is the cntrl word function
Public Function cntrl(txt As String, fnctn As String, optn As String, Optional optnsize As Integer) as Object
'
' A function to control the word functions from excel
'
'
Dim myRange As Range
Set myRange = fndtxt(txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
The fnd txt function
Public Function fndtxt(txt As String) As Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Set fndtxt = ActiveDocument.Range
With fndtxt.Find
.text = txt
.Forward = True
.Execute
End With
End Function
And the style function.
Public Function Style(txt As Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Range
Set myRange = txt
myRange.Style = stylename
End Function
I split them out into individual functions so I could use them separately if I wanted or together in the control function. I am sure this is not the most efficient way but after working on this for 3 days straight I needed to split things up or I was going to have an aneurism. To be through I tried them as sub's instead of functions and got the same error.
I get the same error for all the formatting functions, I just focused on the style one as this seemed the best way to simplify things and make it easier to explain :). Quite happy to post those as well if required.
Sorry if this has been answered, I had a look through the forums but could not see anything like this.
Would appreciate any and all help this is driving me insane.
EDIT:
Thank you very to much to Tim this is now working, here is the changed and working code. I moved the funcs into excel and you can find them below.
Excel Macro
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = Createword
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "DnD is for Nerds Wiki"
Call cntrl(wrdDoc, "DnD is for Nerds Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
The cntrl function
Public Function cntrl(doc As Word.Document, txt As String, fnctn As String, optn As String, Optional optnsize As Integer) As Object
'
' A function to control the word funcitons from excel
'
'
Dim myRange As Word.Range
Set myRange = fndtxt(doc, txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
The fndtxt function
Public Function fndtxt(doc As Word.Document, txt As String) As Word.Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.text = txt
.Forward = True
.Execute
End With
Set fndtxt = rng
End Function
The Style function
Public Function Style(txt As Word.Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Word.Range
Set myRange = txt
myRange.Style = stylename
End Function
A lot of it came down to adding the word. in front of the ranges.
Here's a basic example with all the code on the Excel side:
Sub Tester()
Dim wdApp As Word.Application, doc As Word.Document, rng As Word.Range
Set wdApp = GetObject(, "Word.Application") 'in my testing word is already open
Set doc = wdApp.Documents.Add()
With doc
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
SetTextStyle doc, "Internal Wiki", "Title"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
End With
End Sub
Sub SetTextStyle(doc As Word.Document, txt As String, theStyle As String)
Dim rng As Word.Range
Set rng = WordTextRange(doc, txt)
If Not rng Is Nothing Then
rng.style = theStyle
Else
MsgBox "'" & txt & "' was not found", vbExclamation
End If
End Sub
'return a range containing the text `txt` in document `doc`
' returns Nothing if no match is made
Function WordTextRange(doc As Word.Document, txt As String) As Word.Range
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.Text = txt
.Forward = True
If .Execute() Then 'check that Execute succeeds...
Set WordTextRange = rng
End If
End With
End Function
I'm currently creating an Excel workbook that uses vba to display info from a table stored in the same workbook. I keep getting the error "Object variable or with block variable not set" when trying to run my code. The error comes when I try to read my found line # into my rownum long value. Probably a simple fix along with other unrelated issues but any help is appreciated.
Dim findID As Long
Dim ws As Worksheet
Dim tbl As ListObject
Dim loc As Range
Dim foundLast As String
Dim foundFirst As String
Dim rownum As Long
Dim nameCol As Range
findID = HoursID.Value
Set ws = ActiveWorkbook.Worksheets("Totals")
Set tbl = ws.ListObjects("Totals")
Set nameCol = ws.Range("A2:A500")
Set loc = nameCol.Find(findID, SearchOrder:=xlByRows)
rownum = loc.Row <----------------
I was trying to find the row which contain the date same as my other file. But it has the error 91 on the line defining the row number. Anyone can help me to tackle this prob? The 'mth' was successfully found.
Sub abc()
Dim x As Workbook
Dim y As Workbook
Dim WB As Workbook
Dim PCFilePath As String
Dim PCFile As String
Dim RSFilePath As String
Dim RSFile As String
Dim mth As Date
Dim row_mth As Long
Dim Date1 As Date
Dim Date2 As Date
PCFilePath = Worksheets("Sheet1").Range("B2")
PCFile = Worksheets("Sheet1").Range("B3")
RSFilePath = Worksheets("Sheet1").Range("B8")
RSFile = Worksheets("Sheet1").Range("B9")
mth = Worksheets("Sheet1").Range("B5")
Workbooks.Open (PCFilePath & PCFile), UpdateLinks:=0
Set x = Workbooks.Open(PCFilePath & PCFile)
Workbooks.Open (RSFilePath & RSFile), UpdateLinks:=0
Set y = Workbooks.Open(RSFilePath & RSFile)
Set WB = ThisWorkbook
row_mth = y.Sheets("Sheet1").Range("B:B").Find(What:=mth, LookIn:=xlValues).Row
Dates can be tricky when using Range.Find It can be format dependent, and also the Date data type in VBA is not the same as on the worksheet. One is stored as a Double, the other as a VBA Date data type.
Instead try:
Dim mth as Double
or
.Find(What:=CDbl(mth), ...
I want to see if the value in column A of one workbook is in column A of another workbook (and then return the row). However, I'm stuck at using match.
I tried different approaches with the match function, first with a reference, then I simply typed in a number to match. The problem is: As long as the current workbook (wbCurr) is open, it always looks for the value there. When I close it, it looks in the master file (wbMaster) which is what I want.
Sub ReportCreation()
Dim wbMaster As Workbook, wbCurr As Workbook As Workbook
Dim pathMaster As String, pathCurrent As String As String
Dim rowMaster As Variant
Dim rowCurrent As Long, lRowCurrent As Long, lRowMaster As Long
pathMaster = "C:\Users\VBA\report2019.xlsx"
pathCurrent = "C:\Users\VBA\report 042019.xlsx"
Set wbMaster = Workbooks.Open(pathMaster)
Set wbCurr = Workbooks.Open(pathCurrent) 'current month
' rowMaster = Application.Match(wbCurr.Worksheets(1).Cells(3, 1), wbMaster.Worksheets(1).Range("A:A"), 0)
rowMaster = Application.WorksheetFunction.Match(7, wbMaster.Worksheets(1).Range("A:A"), 0)
Debug.Print rowMaster
End Sub
I am trying to create a button on my Access form that takes the current entry and writes the information to an Excel doc
Public Sub ExportExcel()
Dim ObjEx As Object
Dim WhatIsThisVariableFor As Object
Dim Selec As Object
Dim Column As Integer
Dim Row As Integer
Dim CustName As String
Dim Org As String
Dim Contact As String
Dim Product As String
Dim Quantity As Integer
Dim rst As DAO.Recordset
Set ObjEx = CreateObject("EXCEL.APPLICATION")
Set WhatIsThisVariableFor = ObjEx.Workbooks.Add
'Set rst = CurrentDb.OpenRecordset("Select") <---- This will be used when I get the code working
Column = 1
Row = 1
CustName = "Test" '<---- This is only used for the test
Cells(Row, Column) = CustName
ObjEx.Visible = True
Set Selec = ObjEx.Selection
End Sub
This code creates the Excel doc, but leaves it blank. I think that the Cells(Row, Column) command isn't working because it would have to be called from within excel? I'm not sure (I am very new to VBA)
How can I write to the spreadsheet cells from within Access?
You need to qualify your Cells() function to Excel's application object.
ObjEx.ActiveSheet.Cells(Row, Column).Value = CustName
I would recommend that you also choose the worksheet object explicitly:
Dim ws As object
Set ws = ObjEx.Worksheets("Sheet1")
ws.Cells(row, column).value = CustName