I'm running a query from Access and exporting the results to Excel. Works just like I expect it to. What I would like to do next is manipulate the Excel file (autofit columns, format fields, etc.). I've manipulated Excel worksheets countless times from Excel. However this is the first time, doing it from Access. Below is the code I'm using. The query and export run great.
My issue is I'm unable to select / activate / manipulate Excel. Currently, the only Excel file open is the query result. However, I'm sure my user's will have multiple Excel files open, so I'll need to program for that situation as well.
DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, , True
Set xlapp = GetObject(, "Excel.Application")
MyReport = ""
MyReport = xlapp.workbooks(w).Name
xlapp.Workbook(MyReport).Activate
xlapp.Workbook(MyReport).worksheets(1).Activate
Range(xlapp.Workbook(MyReport).worksheets(1).cells(1, 1), xlapp.Workbook(MyReport).worksheets(1).cells(1, 1)).Select
Any help or suggestions would be greatly appreciated. Thanks in advance for your assistance.........
You can start with something like this. Have fun!
With EarlyBinding:
Sub Access_ControlExcelWorkbook_EarlyBinding()
On Error GoTo errHandler
Dim appExcel As New Excel.Application
Dim xWb As Excel.Workbook
Dim xWs As Excel.Worksheet
Dim xRng As Excel.Range
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Open workbook
Set xWb = appExcel.Workbooks.Open(wbPath)
' Show Excel
appExcel.Visible = True
' Sheet to control
Set xWs = xWb.Worksheets("Sheet1")
' Range to control
Set xRng = xWs.Range("A10")
' Write value in range
xRng.Value = "Control from Access"
' Auto fit columns
xWs.Cells.EntireColumn.AutoFit
' Save workbook
xWb.Save
exitRoutine:
' Close workbook
xWb.Close False
' Close Excel
appExcel.Quit
Exit Sub
errHandler:
Debug.Print Err.Description
Resume exitRoutine
End Sub
With Late Binding:
Public Const xlCenter = -4108
Sub Access_ControlExcelWorkbook_LateBinding()
On Error GoTo errHandler
Dim appExcel As Object
Dim xWb As Object
Dim xWs As Object
Dim xRng As Object
Dim wbPath As String: wbPath = "YourWorkbookPath"
' Exit if workbook don't exist
If Len(Dir(wbPath)) = 0 Then Exit Sub
' Create an instance od Excel
Set appExcel = CreateObject("Excel.Application")
' Copy the rest of the code from early Binding
' Center column G
xWs.Columns("G:G").HorizontalAlignment = xlCenter
End Sub
Related
I would like to access data from Excel to be used in powerpoint. I have found this tutorial https://www.datanumen.com/blogs/2-effective-methods-to-extract-numbers-from-your-excel-cells/, but it describes how to use it in the Excel alone:
Sub ExtractNumbersFromCells()
Dim objRange As Range, nCellLength As Integer, nNumberPosition As Integer, strTargetNumber As String
' Initialization
strTargetNumber = ""
' Go through all the cells in the target range
For Each objRange In Range("B4:B14")
nCellLength = Len(objRange)
' Extract numbers from cells
For nNumberPosition = 1 To nCellLength
If IsNumeric(Mid(objRange, nNumberPosition, 1)) Then
strTargetNumber = strTargetNumber & Mid(objRange, nNumberPosition, 1)
End If
Next nNumberPosition
objRange.Offset(0, 1) = strTargetNumber
strTargetNumber = ""
Next objRange
End Sub
So for example I have my values on rows: B4:B14 ...
and I want to process them in PowerPoint. How to do that?
Here's a very basic example of automating Excel from PPT:
'Requires VBA Project reference to "Microsoft Excel xx.0 Object Library"
Sub Tester()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim x As Long
Set xlApp = New Excel.Application 'open Excel
xlApp.Visible = True 'make visible
Set wb = xlApp.Workbooks.Open("C:\Temp\Test.xlsx") 'open a workbook
Set ws = wb.Worksheets("Sheet1") 'get a worksheet reference
For x = 1 To 5 'loop over a range
Debug.Print ws.Cells(x, 1).Value 'read cell value
Next x
wb.Close False 'don't save changes
xlApp.Quit 'close excel
End Sub
Most of the VBA examples you'll find online cover automating PPT from Excel (since automating the creation of presentations using Excel data is a common use case).
I want below code to open a closed workbook and copy the values from the range StartRow and EndRow to active workbook.
I get
error 1004 "No such interface supported".
on line "xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select"
When I run this code directly in the workbook I want to copy the data from, it works.
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim xlApp As Application
Dim xlBook As Workbook
Dim sh As Object
Set xlApp = CreateObject("Excel.Application")
'Path source Wokrbook
Set xlBook = xlApp.Workbooks.Open("C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\" & Sheets("Data Check").Range("C3").Value & ".xlsx")
xlApp.Visible = True
ShName = Sheets("Data Check").Range("C3").Value
With xlBook.Sheets(ShName)
StartRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1")).Row
EndRow = .Range("E:E").Find(what:="January-2020", after:=.Range("E1"), searchdirection:=xlPrevious).Row
'ThisWorkbook.Activate
xlBook.Sheets(ShName).Range("A2").Value = ShName
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
'Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
End With
xlApp.DisplayAlerts = False
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Set xlBook = ActiveWorkbook
Set sh = Sheets("Dealer_ID Check")
sh.Activate
Range("A1").Select
sh.Paste
End Sub
Putting all the comments together, your code so far could be refactoed as
Option Explicit
Sub GetDataFromClosedBook()
'copy data from closed workbook to active workbook
Dim wbData As Workbook
Dim wbDest As Workbook
Dim wsDataCheck As Worksheet
Dim wsDealerIDCheck As Worksheet
Dim wsReports As Worksheet
Dim ShName As String
Dim PthName As String
Dim FlName As String
Dim rStartRow As Range, rEndRow As Range
Dim rng As Range
Set wbDest = ActiveWorkbook ' not prefered, better to be explicit
Set wsDataCheck = wbDest.Worksheets("Data Check")
'Path source Wokrbook
PthName = "C:\Users\name\Desktop\EXCEL USEFUL DOSC\Missing Data Check New Process\Missing Data Reports\"
FlName = wsDataCheck.Range("C3").Value
ShName = wsDataCheck.Range("C3").Value
On Error Resume Next
Set wbData = Workbooks.Open(PthName & FlName & ".xlsx")
On Error GoTo 0
If wbData Is Nothing Then
' File didn't open
Exit Sub
End If
Set wsReports = Nothing
On Error Resume Next
Set wsReports = wbData.Worksheets(ShName)
On Error GoTo 0
If wsReports Is Nothing Then
' No such sheet
GoTo CleanUp
End If
With wsReports
Set rStartRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
Set rEndRow = .Range("E:E").Find(What:="January-2020", After:=.Range("E1"), SearchDirection:=xlPrevious)
If rStartRow Is Nothing Or rEndRow Is Nothing Then
' Search term not found, What Now?
GoTo CleanUp
End If
.Range("A2").Value = ShName
Set rng = .Range(rStartRow, rEndRow)
' For debug purposes only
.Activate ' the worksheet
rng.Select ' the range
End With
Application.DisplayAlerts = False
' do you want to save the change you made to wbData?
wbData.Close True ' or wbData.Save False
Set wsDealerIDCheck = wbDest.Worksheets("Dealer_ID Check")
' continue ...
Exit Sub
CleanUp:
If Not wbData Is Nothing Then wbData.Close False
End Sub
The comments have pointed out the disassociation in your code many times. Your code uses implicit and explicit references to worksheets without performing any of the necessary checks to prevent errors.
The commenters we're being polite and didn't use strong terms, but I am not polite: ActiveSheet is not what you think it is.
What you think ActiveSheet is during design is practically never guaranteed to be ActiveSheet during run time. There are certainly times when they are but such certainties are rare unless you make the effort to code then into reality. All other times you should explicitly reference your ranges. Consider it a life saving skill
Let's assume you set a pointer to a workbook and you open it, whatever sheet it opens to becomes the ActiveSheet. Typically this is the sheet that was last viewed when the workbook was saved, but that is by no means guaranteed.
What is even less guaranteed, is your assumption that it will open to the "Data Check" sheet.
You can read from and write to the "Data Check" sheet all day long without caring if it is the ActiveSheet or not, but you can only Select a cell on it when it is the ActiveSheet.
The worksheet variableShName is set to the "Data Check" worksheet. At no point have you validated ShName as the ActiveSheet, but ShName must be the ActiveSheet to prevent an error on this line:
xlBook.Sheets(ShName).Range(Cells(StartRow, 1), Cells(EndRow, 1)).Select
So I had this error in word but as was pointed out "ActiveDocument" was the issue even though I only had one word application open. By changing to wdApp.ActiveDocument it resolved it. wdApp being my word.application object.
I am trying to copy Word paragraphs to Excel cells, but I am hung up on
Runtime error 9: Subscript out of range.
I have searched. Everything I read says it cannot find the file, but the file is in the same folder, and the name is not mis-spelled, and the extension is correct. So, I am stumped. The original code comes from here: How to copy a formatted paragraph from Word 2013 to Excel?.
Private Sub Load_Schedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Workbook
Dim ws As Worksheet
Set wDoc = ActiveDocument
Set wb = Workbooks("new.xlsm")
Set ws = wb.Sheets("Sheet1")
ws.Activate
ws.Columns(1).AutoFit
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
Sheets(ws).Cells(ParaCount, 1).PasteSpecial
Paste:=xlPasteFormats
Next ParaCount
End Sub
The error comes on this line: Set wb = Workbooks("new.xlsm")
As you work with both applications, you should use full declarations like Word.Document and Excel.Workbook (if you already referenced the appropriate libraries).
An already opened Excel file can be referenced without path.
The Paste:= ... parameter belongs to the previous code line, so you have to add a blank + undersore at the end of the previous line or put them together into one line.
Please reference your worksheet's cell by ws.Cells ... and not by Sheets(ws), as your "ws" already is a worksheet object and not a string.
The further answer depends, if you run your code from Word-VBA or from Excel-VBA.
Word VBA
If you want to reference an Excel file from Word-VBA, you need the Excel.Application object additionally.
If Excel is already started, you can use the existing application object - otherwise you create one and make it visible.
Same with your Excel file: If it's already open, you use it - if not, you open it.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim objExcel As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If objExcel Is Nothing Then
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
End If
On Error Resume Next
Set wb = objExcel.Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = objExcel.Workbooks.Open(objExcel.DefaultFilePath & "\new.xlsm")
' or ThisDocument.Path or whatever path
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
Excel VBA
In Excel you can try to reference an already opened Word file directly as ActiveDocument without getting the Word.Application additionally.
Private Sub LoadSchedule()
Dim ParaCount As Integer
Dim wDoc As Word.Document
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
On Error Resume Next
Set wb = Workbooks("new.xlsm")
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(Application.DefaultFilePath & "\new.xlsm")
End If
Set wDoc = ActiveDocument
Set ws = wb.Sheets("Sheet1")
For ParaCount = 1 To wDoc.Paragraphs.Count
wDoc.Paragraphs(ParaCount).Range.FormattedText.Copy
ws.Cells(ParaCount, 1).PasteSpecial Paste:=xlPasteFormats
Next ParaCount
ws.Columns(1).AutoFit
'ws.Activate
End Sub
You need to specify the full path to the excel file - you say it's the same as the word document so this will work:
Sub GetXLFileInWord()
Dim xl As Excel.Application
Set xl = New Excel.Application
Dim wb As Excel.Workbook
Set wb = xl.Documents.Open(ThisDocument.Path & "\new.xlsm")
My issue is after I have imported a table from Microsoft Word into Excel by creating an OLEObject, it won't let me copy and paste the table into excel. It continually keeps pasting whatever was last copied on my clipboard into the first cell. Currently my code asks the user for the file name, opens that file as an OLEObject in the active excel sheet, and then pastes the incorrect information into cell A1. It's not copying and pasting what's inside the Word OLEObject.
Sub Macro1()
Dim FName As String, FD As FileDialog
Dim ExR As Range
Set FD = Application.FileDialog(msoFileDialogOpen)
FD.Show
If FD.SelectedItems.Count <> 0 Then
FName = FD.SelectedItems(1)
Else
Exit Sub
End If
ActiveSheet.OLEObjects.Add(fileName:=FName, Link:=False, DisplayAsIcon:=False).Select
Selection.Verb Verb:=xlPrimary
Range("A1").Select
ActiveSheet.Paste
End Sub
Thank you!
From Word to Excel, should be something like this.
Sub ImportFromWord()
'Activate Word Object Library
'Dim WordApp As Word.Application
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\your_path_here_\WordFile.docx") ' open Word file
'copy third row of first Word table
WordDoc.Tables(1).Rows(3).Range.Copy
'paste in Excel
Range("A1").PasteSpecial xlPasteValues
WordDoc.Close 'close Word doc
WordApp.Quit ' close Word
End Sub
Or this.
Sub GetTables()
FName = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
Set WordObject = GetObject(FName)
First = True
RowCount = 2
For Each Tble In WordObject.tables
For i = 1 To 22
If First = True Then
Data = Tble.Rows(i).Cells(1).Range
'Remove cell markers
Cells(1, i) = Left(Data, Len(Data) - 2)
End If
Data = Tble.Rows(i).Cells(2).Range.Text
'Remove cell markers
Cells(RowCount, i) = Left(Data, Len(Data) - 2)
Next i
RowCount = RowCount + 1
First = False
Next Tble
WordObject.Close savechanges = False
End Sub
Using the code from the link How to preserve source formatting while copying data from word table to excel sheet using VB macro? , I've only been able to get the code to work when the macro pastes my Word table in a whole new separate workbook. When clicking a command button that's within the excel workbook that I want to import the Word table to, the table never pastes into the sheet called "Scraping Sheets" I've messed around with the code, but the closest thing I could get was placing the entire table into one cell with all formatting lost.
Private Sub CommandButton22_Click()
Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String
Dim tbl As Object
FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _
On Error Resume Next
Set oWordApp = GetObject(, "Word.Applicaton")
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
Set oWordDoc = oWordApp.Documents.Open(FlName)
Set tbl = oWordDoc.Tables(1)
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open(""C:\Users\xxxx\Desktop\292 Int'l_Weekly_Win_Loss_YYYY MM DD TEMPLATE.xlsm"")
Set ws = wb.Sheets("Scraping Sheet")
tbl.Range.Copy
ws.Range("A1").Activate
ws.Paste
MsgBox "Successfully Added File!"
End Sub
I would like to open Excel from Access and apply filters to a sheet.
Below is my code:
Dim s as String
Set oApp = CreateObject("Excel.Application")
oApp.Wworkbooks.Open FileName:="dudel.xlsm"
oApp.Visible = True
s = "AB"
With oApp
.Rows("2:2").Select
.Selection.AutoFilter
.ActiveSheet.Range("$A$2:$D$9000").AutoFilter Field:=3, Criteria1:= _
Array(s, "E", "="), Operator:=xlFilterValues
.Range("A3").Select
End With
When I ran the code, I got this error:
runt time error 1004 Autofilter methond of range class failed
Can anyone see why?
Try this one. I've commented code in details, but if you have some questions - ask:)
Sub test()
Dim s As String
Dim oApp As Object
Dim wb As Object
Dim ws As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'tries to open workbook
On Error Resume Next
'change file path to the correct one
Set wb = oApp.workbooks.Open(FileName:="C:\dudel.xlsm")
On Error GoTo 0
'if workbook succesfully opened, continue code
If Not wb Is Nothing Then
'specify worksheet name
Set ws = wb.Worksheets("Sheet1")
s = "AB"
With ws
'disable all previous filters
.AutoFilterMode=False
'apply new filter
.Range("$A$2:$D$9000").AutoFilter Field:=3, Criteria1:=Array(s, "E"), Operator:=7
End With
'close workbook with saving changes
wb.Close SaveChanges:=True
Set wb = Nothing
End If
'close application object
oApp.Quit
Set oApp = Nothing
End Sub
and also one more thing: change Operator:=xlFilterValues to Operator:=7 (access doesn't know about excel constanst until you add reference to the excel library in access)