I am trying to automatically fill in tables in a MS word file by retrieving data in various excel tables. In order to properly interact with Excel it would be very handy to work with worksheetfunction. Yet since the macro is in MS Word I am getting blocked. Any way to access it? Cheers
Dim src As Workbook
Dim ws As Worksheet
Dim t As String
Dim c As Integer
t = ThisDocument.Tables(1).Cell(1, 1).Range.Text
t = Left(t, Len(t) - 1)
Set src = workbooks.Open("https://collab.ext.../asd.xlsx", True, True)
Set ws = src.Worksheets("Data")
c = worksheetfunction.Match(t, ws.Range("A1:AA1"), False)
src.Close
Set src = Nothing
#Tim Williams thanks for your help. Corrected code below:
Dim oXL As Object
Dim oWB As Workbook
Dim oWS As Worksheet
Dim wbPath As String
Dim t As String
Dim c As Integer
Set oXL = CreateObject("Excel.Application")
oXL.Visible = False
wbPath = "https://collab.ext...asd.xlsx"
t = ThisDocument.Tables(1).Cell(1, 1).Range.Text
t = Left(t, Len(t) - 2)
Set oWB = oXL.workbooks.Open(wbPath, True, True)
Set oWS = oWB.Sheets("Data")
c = oXL.worksheetfunction.Match(t, oWS.Range("A1:AA3"), False)
oXL.ActiveWorkbook.Close SaveChanges:=False
oXL.Application.Quit
Set oXL = Nothing
Set oWB = Nothing
Set oWS = Nothing
Related
I want to create a pivot table with Access 2003 into Excel. Now I can create a pivot table but background process excel is not close. Results my program can run only once time.
I want to know how to close Excel background process.
My code:
Dim lRET As Integer
Dim lEXCEL_OBJ As Excel.Application
Dim lWKB As Excel.Workbook
Dim lSHEET As Excel.Worksheet
Dim lSHEET2 As Excel.Worksheet
Dim lFILEFULLNAME As String
Dim lTEMPLATEFILE As String
Dim lTEMPLATEPATH As String
Dim lBUTTON As String
Dim PTcache As Excel.PivotCache
Dim PT As Excel.PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Const lFILE As String = "template_macro2.xlt"
On Error GoTo EXCEL_RESULT_T_ERROR
lTEMPLATEPATH = "C:\Temp\" & lFILE
lTEMPLATEFILE = Dir(lTEMPLATEPATH)
Set lEXCEL_OBJ = CreateObject("Excel.Application")
Set lWKB = lEXCEL_OBJ.Workbooks.Add(lTEMPLATEPATH)
With lEXCEL_OBJ
Set lWKB = .Workbooks.Add(lTEMPLATEPATH)
Set lSHEET = .ActiveWorkbook.Sheets(1)
End With
With lEXCEL_OBJ
lWKB.Worksheets.Add
lWKB.ActiveSheet.Name = "test1"
Set lSHEET = .ActiveSheet
End With
With lSHEET
.Range("a:z").ColumnWidth = 10
.Range("b:b").ColumnWidth = 22
.Range("m:m").ColumnWidth = 24
.Range("q:q").ColumnWidth = 50
.Range("u:u").ColumnWidth = 15
End With
'add raw data in excel
Call MAKE_EXPORT_TABLE_DO_OR(lSHEET)
With lEXCEL_OBJ
lWKB.Sheets("Sheet1").Select
lWKB.Worksheets.Add
lWKB.ActiveSheet.Name = "test2"
Set lSHEET2 = .ActiveSheet
'Define Data Range
LastRow = lSHEET.Cells(lSHEET.Rows.COUNT, 1).End(-4162).Row
LastCol = lSHEET.Cells(1, lSHEET.Columns.COUNT).End(-4159).Column
Set PRange = lSHEET.Cells(1, 1).Resize(LastRow, LastCol)
'Create a Pivot Cache
Set PTcache = ActiveWorkbook.PivotCaches.Add(xlDatabase, PRange)
'Create the Pivot Table from the Cache
Set PT = PTcache.CreatePivotTable(TableDestination:=Sheets("test2").Cells(1, 1))
End With
lWKB.SaveAs hFULLPATH
EXCEL_RESULT_T_EXIT:
On Error Resume Next
lWKB.Close
PT.Application.Quit
lEXCEL_OBJ.Application.Quit
Set lWKB = Nothing
Set lEXCEL_OBJ = Nothing
Application.Echo True
DoCmd.Hourglass False
Exit Function
EXCEL_RESULT_T_ERROR:
Resume EXCEL_RESULT_T_EXIT
Below is part of a code that i am using to paste charts into ppt. It is basically picking charts from excel to update the existing ppt. I have also included inline text. where i am getting this error. Please help me identify, why this error is existing.
I am getting error at below line :-
m = shp.TextFrame.TextRange.Find(existing_date_string).Characters.Start
Sub ChangeChartData_phast()
Dim pptChart As Chart
Dim pptChartData As ChartData
Dim sld As Slide
Dim shp As Shape
Dim wbk As Workbook
Dim wbk_copy As Workbook
Dim wbk_paste As Worksheet
Dim filepath As String
filepath = ActivePresentation.Path
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Set wbk_copy = xlApp.Workbooks.Open(filepath & "\development file.xlsm", True, False)
'xlApp.Visible = True
date_string = (wbk_copy.Worksheets("Data").Cells(13, 2))
existing_date_string = (wbk_copy.Worksheets("Data").Cells(14, 2))
wbk_copy.Close True
Set xlApp = Nothing
Set xlApp = CreateObject("Excel.Application")
Set wbk_copy = xlApp.Workbooks.Open(filepath & "\Phast Charts Data.xlsx", True, False)
xlApp.Visible = True
Dim n As Integer
i = i + 1
For Each shp In sld.Shapes
If shp.Name = "Title1" Then
m = shp.TextFrame.TextRange.Find(existing_date_string).Characters.Start
shp.TextFrame.TextRange.Characters(m).InsertBefore (date_string)
shp.TextFrame.TextRange.Find(existing_date_string).Delete
End If
Next
Next n
xlApp.DisplayAlerts = False
wbk_copy.Close False
xlApp.DisplayAlerts = True
Maybe use Replace with a blank string or your text, instead of Delete
shp.TextFrame.TextRange.Replace FindWhat:="###", ReplaceWhat:=""
or try replace using vbNullString.
I'm new to VBA and I'm having difficulty trying to insert comments from data that I have in Excel onto a Word document. I am trying to write the VBA in Word and want it to extract data from a separate spreadsheet
Sub ConvertCelltoWordComment()
Dim Rng As Range
Dim wApp As Object
Dim strValue As String
Dim xlapp As Object
Dim xlsheet As Object
Dim xlbook As Object
'Opens Excel'
Set xlapp = GetObject("C:\Users\eugenechang\Desktop\...xlsx")
If Err Then
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Dim i As Integer
For i = 1 To 5
With xlsheet
strValue = ActiveSheet.Cells(i, 1).Offset(1, 0)
End With
'Insert comment into document'
ActiveDocument.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="15"
ActiveDocument.Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative, Count:=5
ActiveDocument.Comments.Add Range:=Selection.Range, Text:=strValue
Next i
End Sub
I'm trying to get it to work, but it is giving me an error "Object not defined". I've tried setting up an object within the strValue line below "With xlsheet", but am hitting a wall. Any help??
You have not assigned anything to xlsheet - so this (by default) equates to Nothing.
Try setting xlSheet to something meaningful. The following is only an example:
For i = 1 To 5
Set xlsheet = xlbook.Worksheets(i) ' <--- example here
With xlsheet
strValue = .Cells(i, 1).Offset(1, 0) '<-- don't use ActiveSheet
End With
'Insert comment into document'
ActiveDocument.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="15"
ActiveDocument.Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative, Count:=5
ActiveDocument.Comments.Add Range:=Selection.Range, Text:=strValue
Next I
An important note here is that you also have not set xlbook - you must also assign something meaningful to xlbook.
Add a couple DocVariables to your Word file and run the script below, from Excel.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next
objWord.ActiveDocument.variables("FirstName").Value = Range("FirstName").Value
objWord.ActiveDocument.variables("LastName").Value = Range("LastName").Value
' etc., etc., etc.
objWord.ActiveDocument.Fields.Update
'On Error Resume Next
objWord.Visible = True
End Sub
This ended up writing comments from an Excel file. Obviously the names have been changed for privacy reasons. Please let me know if I can simplify this better.
Sub ConvertExceltoWordComment()
Dim wApp As Word.Application
Dim xlApp As Excel.Application
Dim PgNum As Integer
Dim LineNum As Integer
Dim objSelection As Word.Document
Dim strpgSearch As Long
Dim strlinSearch As Long
Dim myRange As Range
Dim XlLog As Excel.Worksheet
Dim RowCount As Long
'Opens Copied Word document'
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Dim SaveDoc As Excel.Workbook
Set SaveDoc = xlApp.Workbooks.Open("FilePath.xlsm") 'Type filepath of document here'
Set XlLog = SaveDoc.Sheets("Worksheet_Name") 'Type Sheetname here'
RowCount = XlLog.Range("A1048576").End(xlUp).Row
If RowCount > 0 Then
Dim iTotalRows As Long
iTotalRows = XlLog.Rows.Count 'Get total rows in the table'
Dim txt As Variant
Dim iRows As Long
End If
Dim i As Integer
'Insert comment into Word document'
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
If Err Then
Set wApp = CreateObject("Word.Application")
End If
Set objSelection = ActiveDocument
For iRows = 3 To iTotalRows
txt = XlLog.Cells(iRows, 8).Text 'Grabs appropriate comment text'
objSelection.Activate
objSelection.SelectAllEditableRanges
strpgSearch = XlLog.Cells(iRows, 2) 'Grabs appropriate Page number'
strlinSearch = XlLog.Cells(iRows, 3) 'Grabs appropriate Line number'
objSelection.ActiveWindow.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext,
Name:=strpgSearch
objSelection.ActiveWindow.Selection.GoTo What:=wdGoToLine, Which:=wdGoToRelative,
Count:=strlinSearch
Set myRange = ActiveWindow.Selection.Range
ActiveDocument.Comments.Add Range:=myRange, Text:=txt
Next iRows
Set xlApp = Nothing
Set SaveDoc = Nothing
Set XlLog = Nothing
Set objSelection = Nothing
Set myRange = Nothing
Set wApp = Nothing
SaveDoc.Close
End Sub
I have a table in word that has two columns. I want to copy only the second column into the 2nd column of my pre-existing table in excel. My 'for' loop is working but all the data is getting repeatedly stored in the same cell.How do i store in consecutive cells of the column?
Sub copyToExcel()
Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim doc As Document
Dim tbl As Table
Dim lstrw As Long, lstcol As Integer
Dim tblrange As Range
Set doc = ThisDocument
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open("C:\Users\ankit\Downloads\challenges.xlsm")
Set xlsheet = xlwb.Worksheets("Challenge #2")
Set tbl = doc.Tables(1)
With tbl
lstrw = .Rows.Count
lstcol = .Columns.Count
For x = 2 To lstrw
Set tblrange = .Cell(x, 2).Range
tblrange.End = .Cell(lstrow, lstcol).Range.End
tblrange.Copy
xlsheet.Paste
Next x
End With
Set xlapp = Nothing
Set xlwb = Nothing
Set tblrange = Nothing
Set xlsheet = Nothing
Set doc = Nothing
End Sub
This problem has consumed a lot of my time now. Everytime I run code from access to launch excel read file location and then open the excel on that file location, make changes and close. I see that this leaves an orphan excel process. I have tried all ways of referencing and possible solutions suggested out on internet, but nothing to help. My code as below. Any help or suggestions would be great:
Public Sub productdetailprinter()
Dim i As Double
Dim dbs As DAO.Database
Dim recSet As Recordset
Dim wb As Workbook
Dim ws As Worksheet
Dim tableName As String
Dim recTable As Recordset
Dim fld As DAO.Field
Dim k As Integer
Dim r As Integer
Dim intformat As Integer
Dim wrksht As Worksheet
Dim wrkbk As Workbook
Dim filelocation As String
Dim xl As Excel.Application
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set dbs = CurrentDb
Set recSet = dbs.OpenRecordset("tbl_formList")
Set wrkbk = xl.Workbooks.Open("<location>")
Set wrksht = wrkbk.Worksheets("databaselinks")
filelocation = wrksht.Range("C5").Value
wrkbk.Close
xl.Quit
Set wrksht = Nothing
Set wrkbk = Nothing
Set xl = Nothing
Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Application.DisplayAlerts = False
xl.Workbooks.Application.AskToUpdateLinks = False
Set wb = xl.Workbooks.Open(filelocation & "\product_detail.xlsx")
Set ws = wb.Worksheets("details")
xl.Workbooks.Application.AskToUpdateLinks = True
xl.Workbooks.Application.DisplayAlerts = True
ws.Range("B3", Range("B3").End(xlDown)).Select
xl.Selection.Clear
ws.Range("C3", Range("C3").End(xlDown)).Select
xl.Selection.Clear
ws.Range("D3", Range("D3").End(xlDown)).Select
xl.Selection.Clear
i = ws.Columns("B").End(xlDown).Row
i = i + 1
Do Until recSet.EOF
'code lines
recSet.MoveNext
Loop
ws.Save
wb.Close
xl.Quit
Set xl = Nothing
Set ws = Nothing
Set wb = Nothing
recTable.Close
recSet.Close
End Sub
You must close the objects in exact reverse order:
' Also:
Dim rng As Excel.Range
Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wrkbk = xl.Workbooks.Open("<location>")
Set wrksht = wrkbk.Worksheets("databaselinks")
Set rng = wrksht.Range("C5")
filelocation = rng.Value
Set rng = Nothing
Set wrksht = Nothing
wrkbk.Close
Set wrkbk = Nothing
xl.Quit
Set xl = Nothing
This is tested and works at me:
Public Sub EditWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim Column As Integer
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\test.xlsx")
Set wks = wkb.Worksheets(1)
Set rng = wks.Range("C5")
rng.Value = 4
wkb.Close True, "c:\test\test1.xlsx"
Set rng = Nothing
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub
Thank you for proposed solutions. After spending 4 hours on this.. I realized that vba wasnt happy with the way I was referencing the ranges.
ws.Range("B3", Range("B3").End(xlDown)).Select
should be referenced as
ws.Range(ws.Range("B3"), ws.Range("B3").End(xlDown)).Select
It works like a charm.. Excel instances die and no more errors.
Hope this saves someones time out there.
Thank You