I created code that will copy the RecordSet to Excel and I want a macro in the Excel file to run. The code works perfectly until it hits the code to run the macro. I must not be calling the application correctly but can't figure it out!
Private Sub Command233_Click()
Dim objXLS As Object
Dim wks As Object
Dim rsc As Recordset
Dim idx As Long
Set rsc = Me.RecordsetClone
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox ("No Records To Export")
Else
rsc.MoveLast
rsc.MoveFirst
Set objXLS = CreateObject("Excel.Application")
objXLS.Workbooks.Open FileName:="C:\Comps Macro.xlsm", ReadOnly:=True
Set wks = objXLS.Worksheets(1)
For idx = 0 To rsc.Fields.Count - 1
wks.Cells(1, idx + 1).Value = rsc.Fields(idx).Name
Next
wks.Range(wks.Cells(1, 1), wks.Cells(1, rsc.Fields.Count)).Font.Bold = True
wks.Range("A2").CopyFromRecordset rsc, rsc.RecordCount, rsc.Fields.Count
objXLS.Visible = True
objXLS.Run ("Format")
End If
Set objXLS = Nothing
End Sub
The runtime error I am receiving is:
Run-Time Error '-2147417851 (80010105)':
Method 'Run' of object '_Application' failed
You have to reference the Sub or Function correctly.
Your Sub named Format is defined at Workbook- or Sheet- level?
If defined in a Sheet module (for example Sheet1):
objXLS.Run ("Sheet1.Format")
If at Workbook level:
objXLS.Run ("ThisWorkbook.Format")
Hope this helps
Related
When the code is applied to a pivot table that has no PageRange property the code fails with the error in the title
I tried to apply a boolean variable to
sh.PivotTables(i).PageRange
but that did not work either
Sub TestPivotPaste2()
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ActiveWorkbook
Set sh = wb.Worksheets(7)
c = sh.PivotTables.Count
If c > 0 Then
For i = 1 To c
If Not sh.PivotTables(i).PageRange.Count = 0 Then
Debug.Print c
Else
GoTo nextpiv
End If
nextpiv:
Next i
Else
MsgBox ("NoPivot")
End If
End Sub
the expected result is to be able to discern the pivot tables where the PageRange property is true or false, but it only works when the range exists.
Try this function
Function pageRangeExists(pt as PivotTable) as Boolean
Dim test as Range
On Error Resume Next
Set test = pt.PageRange
On Error Go To 0
pageRangeExists = Not test Is Nothing
End Function
Since PageRange is a range object, you have to test if the range exists or is valid first, as trying to act against a range that is not there will produce an error.
And with that your for loop can be simplified
For i = 1 To c
If pageRangeExists(sh.PivotTables(i)) Then
Debug.Print c
End If
Next i
The GoTo statement is superfluous as it is logic already embedded in a for loop.
I am writing a macro in CATIA v5 using VBA. The program is suppose to take points from a geometric set and transfer them into an excel file. I have successfully gotten the excel document open, a header created, but then I receive "Run-time error '438': Object doesn't support this property or method.
I have tried searching around and it seems like the section of code is trying to interact with something outside of its domain, but I cannot figure out how. Below is a sample of my code. The line that contains "***" to the left is the line that is being pointed out in the debugger.
Dim xls As Object
Dim wkbks As Object
Dim wkbk As Object
Dim wksheets As Object
Dim sheet As Object
Dim fs, f, f1, fc, s
Dim coords(2) As Integer
Dim PartDoc
Sub CATMain()
CATIA.ActiveDocument.Selection.Search "CATGmoSearch.Point,all"
'Function Calls
AppStart
CATIAtoXLS
'wksheet.Application.ActiveWorkbook.SaveAs (ExcelFolder & Left(CATIA.ActiveDocument.Name,Len(CATIA.ActiveDocument.Name)-8)&".xls")
'wksheet.Application.ActiveWorkbook.Close
End Sub
Private Sub AppStart()
Err.Clear
On Error Resume Next
Set xls = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set xls = CreateObject("Excel.Application")
End If
xls.Application.Visible = True
Set wkbks = xls.Application.Workbooks
Set wkbk = wkbks.Add
Set wksheets = wkbk.Worksheets(1)
Set sheet = wkbk.Sheets(1)
sheet.Cells(1, "A") = "X-Cord"
sheet.Cells(1, "B") = "Y-Cord"
sheet.Cells(1, "C") = "Z-Cord"
End Sub
Private Sub CATIAtoXLS()
For i = 1 To CATIA.ActiveDocument.Selection.Count
Set Selection = CATIA.ActiveDocument.Selection ***
Set Element = Selection.Item(i)
'Transfer data to xls
Point.GetCoordinates (coords)
sheet.Cells(i + 1, "A") = coords(0)
sheet.Cells(i + 1, "B") = coords(1)
sheet.Cells(i + 1, "C") = coords(2)
Next i
End Sub
Your first issue is that in any method in CATIA VBA which passes an array as an argument, must be called on a object declared variant (explicitly or by default).
So you it should look like this:
Dim px as Variant
Set px = CATIA.ActiveDocument.Selection.Item(i).Value
Call Point.GetCoordinates(coords)
The second problem is that in VBA if you use a subroutine with parentheses, you must use the Call keyword:
Call Point.GetCoordinates (coords)
Otherwise, you can skip the parentheses and the keyword:
Point.GetCoordinates coords
I am getting inconsistent results when I try to refer to an active workbook. About half the time I get the "Method of 'Sheets' of Object '_Global' not failed" error and other times the code works fine. I don't see a pattern.
The VBA code is part of a Word document that allows the user to open a template Excel file and select/copy text from the Word doc into rows on the Excel file.
In a previous sub I successfully open an Excel template file (I call it a RTM template). In the code below I want to activate the "RTM" worksheet, select the first cell where the template could already have data in it from a previous execution and if there is, then count how many rows of data exist. In this way the new data will be posted in the first row which does not have any data. I am using named ranges in my Workbook to refer to the starting cell ("First_Cell_For_Data").
When I run my code sometimes it runs without error and other times it stops on the "Sheets("RTM").Activate" and gives me the "Method...." error. The same result occurs when I change the variable definition of wb_open to Object. I have also tried using "wb_open.Sheets("RTM").Activate" with the same results.
As suggested in the comments below I added "If wb_open is nothing ...." to debug the issue. I also added the sub List_Open_Workbooks which enumerates the open workbooks (of which there is only 1) and activates the one that matches the name of the one with the correct filename. This is successful. But upon returning to Check_Excel_RTM_Template I still get the Method error on the "Sheets("RTM").Activate" line.
Second Update: after more time diagnosing the problem (which still occurs intermittently) I have added some code that may help getting to the root of the problem. In the "List_Open_Workbooks" sub I test for xlApp.Workbooks.Count = 0. So all references to an open Excel workbook will fail. At this point my template workbook is open in Windows. Am I drawing the correct conclusion?
Third Update: I tried Set wb_open = GetObject(str_filename) where str_filename contains the name of the Excel template file I just opened.
I get the following error message.
Also, I noticed that if I start with a fresh launch of Word and Excel it seems to run just fine.
Sub Check_Excel_RTM_Template(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim i_starting_row_for_data As Integer
Dim wb_open As Object
Set wb_open = ActiveWorkbook
i_rows_of_data = 0
If wb_open Is Nothing Then
MsgBox "RTM Workbook not open in Check_Excel_RTM_Template"
Call List_Open_Workbooks(b_Excel_File_Has_Data, i_rows_of_data)
Else
' On Error GoTo Err1:
' Sheets("RTM").Activate
' range("First_Cell_For_Data").Select
Workbooks(wb_open.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
Exit Sub
Err1:
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
Sub to enumerate all open workbooks
Sub List_Open_Workbooks(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim str_filename As String
Dim xlWB As Excel.Workbook
If xlApp.Workbooks.Count = 0 Then
MsgBox "Error: Windows thinks there are no workbooks open in List_Open_Workbooks"
b_abort = True
Exit Sub
End If
For Each xlWB In xlApp.Workbooks
Debug.Print xlWB.Name
str_filename = getName(str_Excel_Filename)
If Trim(xlWB.Name) = Trim(str_filename) Then
xlWB.Activate
If xlWB Is Nothing Then
MsgBox "Workbook still not active in List_Open_Workbooks"
b_abort = True
Exit Sub
Else
' Sheets("RTM").Activate
Workbooks(xlWB.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
Function to extract filename from path/filename
Function getName(pf)
getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0) & ".xlsx"
End Function
I am hoping I found the source of my problem and solved it.
I believe that referring to an open workbook in sub using Dim wb_open As Object & Set wb_open = ActiveWorkbook in the Check_Excel_RTM_Template sub is causing my inconsistent problems....perhaps this is an anomoly (bug) in the VBA implementation in Word.
In the revised code I posted below I am passing the o_Excel object from the calling routine and using oExcel.Activesheet.xxx to reference ranges and values.
Now I next problem is that I am having errors on the form control button code which also uses the Dim wb_open As Object & Set wb_open = ActiveWorkbook approach to referring to the open workbook. But I'll post that as a new question.
Thanks to all who commented and provided suggestions.
Sub Check_Excel_RTM_Template(oExcel As Object)
Dim i_starting_row_for_data As Integer
Dim str_filename As String
i_rows_of_data = 0
On Error GoTo Err1:
oExcel.ActiveSheet.range("First_Cell_For_Data").Select
If Trim(oExcel.ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(oExcel.ActiveCell.Value) = ""
oExcel.ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
Exit Sub
Err1:
Documents(str_doc_index).Activate
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
I have a working Outlook macro which exports the task list of the current user to an Excel spreadsheet, but I want to change it to use late binding for ease of distribution (ie I don't have to explain to other users about setting a library reference etc.)
I followed the example Convert Early Binding VBA to Late Binding VBA : Excel to Outlook Contacts to set my Excel variables as objects.
Below is a comparison of how i declared the variables pre/post binding change:
'Late binding variables and their early binding equivilants
Dim objExcel As Object 'Dim objExcel As New Excel.Application
Dim exWB As Object 'Dim exWb As Excel.Workbook
Dim sht As Object 'Dim sht As Excel.Worksheet
Dim Range As Object 'Dim Range As Excel.Range
Dim r As Object 'Dim r As Range
Dim cell As Object 'Dim cell As Range
'set application
Set objExcel = CreateObject("Excel.Application")
I am now getting a runtime 1004 error in the following section of my code:
With objExcel.ActiveSheet
Set r = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)) 'runtime 1004 error here after late binding modification
End With
For Each cell In r
s = cell.Text
If Len(Trim(s)) > 0 Then
iloc = InStr(1, s, sChar, vbTextCompare)
If iloc > 1 Then
s1 = Left(s, iloc - 1)
cell.Value = s1
Else
If iloc <> 0 Then
cell.ClearContents
End If
End If
End If
Next cell
y = y + 1
stat_string = ""
End If
Next x
'Autofit all column widths
For Each sht In objExcel.ActiveWorkbook.Worksheets
sht.Columns("A").EntireColumn.AutoFit
sht.Columns("B").EntireColumn.AutoFit
sht.Columns("C").EntireColumn.AutoFit
sht.Columns("D").EntireColumn.AutoFit
sht.Columns("E").EntireColumn.AutoFit
sht.Columns("F").EntireColumn.AutoFit
Next sht
exWB.Save
exWB.Close
Set exWB = Nothing
'this kills the excel program from the task manager so the code will not double up on opening the application
'sKillExcel = "TASKKILL /F /IM Excel.exe"
'Shell sKillExcel, vbHide
objExcel.Application.Quit
I have included the rest of the code after the error line so, if there are further run-time problems, they might be picked up by the incredible people on SO.
I'm assuming that the methodology for declaring my "Range" is incorrect, but I am not really sure why, and therefore unsure on how to fix it.
Any body out there with a suggestion?
Thanks!
xlUp is an Excel constant that is defined in the Excel library. If you have removed the reference, then xlUp will be an undeclared variable.
If you have Option Explicit set, then you should find that when compiling.
I have an Excel Spreadsheet (let's say objectdata.xls) which is used to set the widths/lengths of different rectangles. The spreadsheet therefore has 3 columns:
Object Name
Object Width
Object Length
There are approx 100 rectangles defined in the Spreadsheet
What i am try to do is run a macro in a PowerPoint (PP) which will read the data from the Spreadsheet (ideally this info should be stored external to the PP file but if need be it could be a linked or embedded file within PP) and then update the size of the rectangle shapes that I have included in the PP file.
E.g. on slide one, the macro reads row 1 in the spreadhseet and sees that the object width is 5 and length is 10, and so updates the size of the rectangle shape in the PP.
Can anyone tell me if this can be done?
Thanks.
Use GetExcelData to do the work; it calls GetExcel
Function GetExcel() As Object
'---------------------------------------------------------------------------------------
' Procedure : GetExcel
' Author : Naresh Nichani / Steve Rindsberg
' Purpose :
' Check if an instance of Excel is running. If so obtain a reference to the running Excel application
' Otherwise Create a new instance of Excel and assign the XL application reference to oXLApp object
' SR : Modified 2010-02-23 to ALWAYS create a new instance rather than using an existing one, so when we
' : close the one we open, we don't wack the user's other instances of Excel if any
' Params : None
' Returns : An Excel Application object on success, Nothing on failure
'---------------------------------------------------------------------------------------
On Error GoTo GetExcel_ErrorHandler
On Error Resume Next
Err.Number = 0
Dim oXLAPP As Object
' Comment out the following bits to force a new instance of Excel
' and leave any existing instances alone
' Set oXLApp = GetObject(, "Excel.Application")
' If Err.Number <> 0 Then
' Err.Number = 0
Set oXLAPP = CreateObject("Excel.Application")
If Err.Number <> 0 Then
'MsgBox "Unable to start Excel.", vbInformation, "Start Excel"
Exit Function
End If
' End If
On Error GoTo GetExcel_ErrorHandler
If Not oXLAPP Is Nothing Then
Set GetExcel = oXLAPP
Else
[MASTTBAR].rnrErrLog "modExcel:GetExcel - unable to invoke Excel instance"
End If
Set oXLAPP = Nothing
Exit Function
NormalExit:
On Error GoTo 0
Exit Function
GetExcel_ErrorHandler:
Resume NormalExit
End Function
Function GetExcelData(sFilename As String, _
Optional lWorksheetIndex As Long = 1, _
Optional sWorksheetName As String = "") As Variant
'---------------------------------------------------------------------------------------
' Purpose : Gets the "active" data from the file/worksheet specified
Dim oXLAPP As Object
Dim oxlWB As Object
Dim oxlRange As Object
Dim x As Long
Dim y As Long
Dim sMsg As String
Dim lVisibleRowCount As Long
Dim lVisibleColCount As Long
Dim aData() As String
On Error GoTo GetExcelData_ErrorHandler
Set oXLAPP = GetExcel()
If oXLAPP Is Nothing Then
Exit Function
End If
' open the workbook read-only
Set oxlWB = oXLAPP.Workbooks.Open(sFilename, , True)
If oxlWB Is Nothing Then
Exit Function
End If
If Len(sWorksheetName) > 0 Then
Set oxlRange = GetUsedRange(oxlWB.Worksheets(sWorksheetName))
Else
Set oxlRange = GetUsedRange(oxlWB.Worksheets(lWorksheetIndex))
End If
If oxlRange Is Nothing Then
Exit Function
End If
' Get a count of visible rows/columns (ignore hidden rows/cols)
For x = 1 To oxlRange.Rows.Count
If Not oxlRange.Rows(x).Hidden Then
lVisibleRowCount = lVisibleRowCount + 1
End If
Next ' row
For y = 1 To oxlRange.Columns.Count
If Not oxlRange.Columns(y).Hidden Then
lVisibleColCount = lVisibleColCount + 1
End If
Next
ReDim aData(1 To lVisibleRowCount, 1 To lVisibleColCount)
lVisibleRowCount = 0
For x = 1 To oxlRange.Rows.Count
If Not oxlRange.Rows(x).Hidden Then
lVisibleRowCount = lVisibleRowCount + 1
lVisibleColCount = 0
For y = 1 To oxlRange.Columns.Count
If Not oxlRange.Columns(y).Hidden Then
lVisibleColCount = lVisibleColCount + 1
aData(lVisibleRowCount, lVisibleColCount) = oxlRange.Cells(x, y).Text
End If
Next
End If
Next
' return data in array
GetExcelData = aData
NormalExit:
On Error GoTo 0
' Close the workbook
If Not oxlWB Is Nothing Then
oXLAPP.DisplayAlerts = False
oxlWB.Close
oXLAPP.DisplayAlerts = True
End If
'To Close XL application
If Not oXLAPP Is Nothing Then
oXLAPP.Quit
End If
'Set the XL Application and XL Workbook objects to Nothing
Set oxlRange = Nothing
Set oxlWB = Nothing
Set oXLAPP = Nothing
Exit Function
GetExcelData_ErrorHandler:
Resume NormalExit
End Function
Blockquote
Blockquoteenter code here
Yes, this can certainly be done. It takes a bit more code than I have at the tip of my fingers and you'd need to adapt whatever I posted. But have a look here for examples you can start with. These point to the PowerPoint FAQ site that I maintain. No charge for anything.
Controlling Office Applications from PowerPoint (by Naresh Nichani and Brian Reilly)
http://www.pptfaq.com/FAQ00795.htm
Automate Excel from PowerPoint. Automate PowerPoint from Excel. And so on.
http://www.pptfaq.com/FAQ00368.htm
I'd probably do this by opening the excel file, reading the contents into an array, then using the data from the array to do the actual work in PPT.
If you need help with the PPT part, let us know. It'd mostly be a matter of writing a function like [aircode]:
Sub SetRectangleSize ( sRectangleName as string, sngWidth as Single, sngHeight as Single)
Dim oShp as Shape
Set oShp = GetShapeNamed(sRectangleName, lSlideIndex)
If Not oShp is Nothing Then
With oShp
.Width = sngWidth
.Height = sngHeight
End With
End If
End Sub
And
Function GetShapeNamed(sName as String, lSlideIndex as Long) as Shape
On Error Resume Next
Set GetShapeNamed = ActivePresentation.Slides(lSlideIndex).Shapes(sName)
If Err.Number <> 0 Then
' no shape by that name on the slide; return null
Set GetShapeNamed = Nothing
End If
End Function
Incidentally, I would consider using tags to identify the rectangles rather than shape names (which tend to be less reliable).