I am trying to run a VBA script (the script refers to a button, CommandButton1_Click ()), from a Python script. But all the time he writes an error that the macro cannot be found. I tried different spellings of names, put the macro as Public Sub. The CommandButton1_Click () macro itself calls the main macro. It is what, in fact, is needed, but it is launched only through CommandButton1_Click (). It seems to me that the point is in the passed argument, but how to pass it correctly? ActiveSheet.Name not working
Python:
if os.path.exists(r'./Результат/Отчет_Собираемость — копия.xlsm'):
excel_macro = win32com.client.DispatchEx("Excel.Application")
excel_path = os.path.expanduser(r'\\guo.local\DFSFILES\MSK\HOME\dobychin.ia\Desktop\report collection\1 вариант(Загрузка данных - Python, формирование отчета -VBA)\Результат/Отчет_Собираемость — копия.xlsm')
workbook = excel_macro.Workbooks.Open(Filename=excel_path, ReadOnly =1)
param = "ActiveSheet.Name"
# excel_macro.Application.Run("Отчет_Собираемость.xlsm!Лист3 (ОТЧЕТ_день).CommandButton1_Click()")
excel_macro.Application.Run("CommandButton1_Click")
workbook.Save()
excel_macro.Application.Quit()
del excel_macro
VBA:
Private Sub CommandButton1_Click()
Call main(ActiveSheet.Name)
MsgBox ("Готово!")
End Sub
VBA:
Sub main(ws_name)
Call optimize
Call dell_sheets
Set ws = ThisWorkbook.Sheets(ws_name)
ws.CommandButton1.Visible = False
ws.SpinButton1.Visible = False
Set dws = ThisWorkbook.Sheets("!Периоды")
i = 1
Do While dws.Cells(i, 3) <> ""
mc = dws.Cells(i, 3)
ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set aws = ActiveSheet
aws.Cells(3, 2) = mc
Application.Calculate
aws.UsedRange.Value = aws.UsedRange.Value
aws.Name = mc
i = i + 1
Loop
ws.Activate
ws.CommandButton1.Visible = True
ws.SpinButton1.Visible = True
Call unoptimize
End Sub
Related
I wrote below script but get hung up on this part of the code:
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
What I'm trying to do: if the value of the cell returns #N/A as part of a function I would like to move to next loop. Any recommendation on how to accomplish this?
Thanks in advance for solutions. Also always open to recommendations on how to better structure this code, as I'm still a beginner.
Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim S_Deal As Range
Dim i As Integer
'SourceWb - Workbook were data is copied from
'TargetWb - Workbook were data is copied to and links are stored
Application.ScreenUpdating = False
Set TargetWb = ThisWorkbook
filePath = ThisWorkbook.Sheets("Expenses").Range("S4").Value
Set SourceWb = Workbooks.Open(filePath)
For i = 1 To 6
If TargetWb.Sheets("Expenses").Range("F61").Offset(0, i - 1).Value = CVErr(xlErrNA) Then GoTo Skip Else GoTo Continue
Continue:
Set S_Deal = TargetWb.Sheets("Expenses").Cells(11, 5 + i)
SourceWb.ActiveSheet.Range("OPEX_Control").Value = S_Deal.Value
TargetWb.Sheets("Expenses").Range("F12:F15").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("P9:P12").Value
TargetWb.Sheets("Expenses").Range("F18:F21").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o14:o17").Value
TargetWb.Sheets("Expenses").Range("F23:F26").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o19:o22").Value
TargetWb.Sheets("Expenses").Range("F29").Offset(0, i - 1).Value = SourceWb.ActiveSheet.Range("o25").Value
Skip:
Next i
Application.ScreenUpdating = True
End Sub
If you want to check whether the excel function return #N/A in vba, you can use the following code:
If Application.WorksheetFunction.IsNA(Cells(intRow, x)) Then
Since what you want is the execute a code unless the the wb.function is not #N/A, by re-arrange your If VBA code should be able to achieve your desired outcome.
If Application.WorksheetFunction.IsNA(TargetWb.Sheets("Expenses").Range("F61")) = false then
{your code}
end if
next i
So when the wb function return #N/A, it will not execute the code in between and go to next loop
Private Sub Workbook_Open()
Dim SourceList(0) As Workbook
Dim PathList() As String
Dim n As Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(n) = ActiveWorkbook
ActiveWindow.Visible = False
Next
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
Application.DisplayAlerts = False
For n = 0 To UBound(SourceList)
SourceList(n).Close
Next
Application.DisplayAlerts = True
End Sub
The line For n = 0 to PathList.GetUpperBound(0) is throwing a "Compile Error (invalid qualifier) whenever I try to run this macro. Specifically it highlights PathList as being the problem.
Also, if I cut out the loop and just have the contents run once (replacing the PathList(n) with "\data\WeaponInfo.csv"), it throws an "Object Variable or With block variable not set" error on the SourceList(0) = ActiveWorkbook line. What am I doing wrong?
I'm aware that the loop is currently pointless; it's futureproofing as I'm going to be using this macro to open multiple data references.
EDIT: Made changes suggested by #Jeremy below, now getting the "Object variable or With block variable not set" error on the SourceList(n).Close line.
EDIT2: Fixed the loop, again on the advice of #Jeremy, by changing Dim SourceList(1) As Workbook to Dim SourceList(0) As Workbook
A couple of issues:
In VBA, the GetUpperBound method does not exist, it is for .NET only. Change it to Ubound function.
You may run into a problem with Sourcelist(0) = ActiveWorkbook. Use the Set keyword when assigning object references.
Source is not defined in your loop. ALWAYS put Option Explicit at the top of your code module to force you to declare your variables. It will save pain in the future.
What are you trying to do with splitting that string? you will just get one value, which is the string you are passing in.
Private Sub Workbook_Open()
Dim SourceList(1) As Workbook
Dim PathList() As String
Dim n as Integer
PathList = Split("\data\WeaponInfo.csv", ",")
ThisWorkbook.Activate
Application.ActiveWindow.Visible = False
Application.ScreenUpdating = False
For n = 0 To Ubound(PathList)
Workbooks.Open Filename:=ThisWorkbook.Path & PathList(n)
Set SourceList(0) = ActiveWorkbook
Next
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Workbooks.Open Filename:=ThisWorkbook.Path & "\HeroForge Anew 3.5 v7.4.0.1.xlsm", UpdateLinks:=3
ActiveWindow.Visible = True
For Each Source In SourceList
Source.Close
Next
End Sub
new and would like to ask if someone could possibly check my code to see where i'm making a mistake.
first, i've created a form with two textboxes and two buttons that will go and get two different directories and the associated files. this is done through a call to a function that loads the dir to the textboxes.
a button to call a function to navigate dir and get the file
Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub
function to get workbooks into textboxes 1 and 2:
Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
On Error GoTo exit_
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
workbookFilePath1 = Dir(fileNamePath1)
'TextBox1.Text = workbookFilePath1
TextBox1.Value = fileNamePath1
fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
workbookFilePath2 = Dir(fileNamePath2)
TextBox2.Value = fileNamePath2
If fileNamePath1 = False Or fileNamePath2 = False Then
MsgBox ("File selection was canceled.")
Exit Function
End If
End If
exit_:
End Function
up to here, the code is ok... can do better, but
here's where problems occur... i'd like to pass the directories as objects into the module to diff
button that executes module to diff:
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
i know that i've changed myPath1 and myPath2 to Workbooks, where I've had them as strings before
diffing module
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2
Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet
Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True
Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)
Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add
While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
myWorksheetCounter = ActiveWorkbook.Worksheets.count
myWorksheetCount = ActiveWorkbook.Worksheets.count
If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)
For myWorksheetCounter = i To WorksheetObj1
For myWorksheetCount = j To WorksheetOjb2
'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
Else
cell.Interior.ColorIndex = 0
End If
Next
'if doesn't work... use SaveChanges = True
myNewWorksheetObj.Workbooks.Save() = True
Next
Else
MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
End If
Wend
Set myExcelObj = Nothing
End Sub
So my question is... can someone please assist in seeing where i'm going wrong? essentially, i'm having some issues in trying to get this working.
much appreciated
i've gone through and cleaned up some areas a little bit... but now have a: "run time error '438': object doesn't support this propety or method" at the while loop code that i've updated the post with
I see a typo on CommandButton1_Click
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
There might be something more, but your not capitalizing the "T" in getThe, but you call it that way.
I have this very simple function
Public Function HRows(xx As String)
BeginRow = 2
EndRow = 10
' HideRows
For RowCnt = BeginRow To EndRow
Cells(RowCnt,ChkCol).EntireRow.Hidden = True
Next RowCnt
End Function
When invoked from a command button it works fine, when invoked as a formula, e.g =HRows(A1), from a worksheet cell it doesn't do anything on Excel 2003, it does work in Open Office Calc 4.1
This happens on an otherwise empty spreadsheet - no protection, no comments, no shapes (which have been suggested as inhibitors in other questions)
Eventually, I want to hide/show the relevant sections of a spreadsheet, depending on what the user enters in certain key cells - I don't want to have to add command buttons to control the hiding.
I've already introduced this method here https://stackoverflow.com/a/23232311/2165759, for your purpose a code will be as follows:
Place code to one of the module of VBAProject:
Public Tasks, PermitNewTasks, ReturnValue
Function HideRowsUDF(lBegRow, lEndRow) ' Use this UDF on the sheet
If IsEmpty(Tasks) Then TasksInit
If PermitNewTasks Then Tasks.Add Application.Caller, Array(lBegRow, lEndRow)
HideRowsUDF = ReturnValue
End Function
Function HideRows(lFrom, lUpTo) ' actually all actions performed within this function, it runs without UDF limitations
Range(Rows(lFrom), Rows(lUpTo)).EntireRow.Hidden = True
HideRows = "Rows " & lFrom & "-" & lUpTo & " were hidden"
End Function
Sub TasksInit()
Set Tasks = CreateObject("Scripting.Dictionary")
ReturnValue = ""
PermitNewTasks = True
End Sub
Place code to ThisWorkbook section of Microsoft Excel Objects in VBAProject:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim Task, TempFormula
If IsEmpty(Tasks) Then TasksInit
Application.EnableEvents = False
PermitNewTasks = False
For Each Task In Tasks
TempFormula = Task.FormulaR1C1
ReturnValue = HideRows(Tasks(Task)(0), Tasks(Task)(1))
Task.FormulaR1C1 = TempFormula
Tasks.Remove Task
Next
Application.EnableEvents = True
ReturnValue = ""
PermitNewTasks = True
End Sub
I have a large excel sheet with a log that consists of around 30000 entries.
The programmer before me has created a removeline.cmd file to remove all extra blank lines in a certain column for the excel file.
The code for the RemoveLine.cmd:
cls
cd\
SET vbfile=newlinetest.exe
K:
cd "IPM - CompOps\Ops Docs\avail-stats\Originals"
%vbfile%
exit
The file runs correctly but at the end it displays this error, which is essentially what I'm trying to get rid of:
Run-time error '1004';
Method '~' of object '~' failed
EDIT:
the program newlinetest.exe was written in VB6 (I have access to it on my machine).
The full source-code for newline.frm is:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 4500
ClientLeft = 3435
ClientTop = 3585
ClientWidth = 5175
LinkTopic = "Form1"
ScaleHeight = 4500
ScaleWidth = 5175
Begin VB.CommandButton Command1
Caption = "Excel"
Height = 495
Left = 1800
TabIndex = 0
Top = 3720
Width = 855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim oXL As Object ' Excel application
Dim oBook As Object ' Excel workbook
Dim oSheet As Object ' Excel Worksheet
Dim oChart As Object ' Excel Chart
Dim year As String
Dim i As Long
Dim MyRowNumber As Long
Dim Row As Long
Dim comment As String, newline As String
Dim curDate As String
Open "K:\IPM - CompOps\Ops Docs\avail-stats\Originals\Inputavailfile.txt" For Input As #1
Input #1, Data
Close #1
'Start Excel and create a new workbook
Set oXL = CreateObject("Excel.application")
Set oBook = oXL.Workbooks.Add
Set oSheet = oBook.Worksheets.Item(1)
oXL.Visible = True
oXL.UserControl = True
year = Format(Now, "yyyy")
curDate = Date - 3
curDate = Format(curDate, "m/d/yyyy")
Application.DisplayAlerts = False
Workbooks.Open FileName:="K:\IPM - CompOps\Ops Docs\avail-stats\Originals\" + Data
Myfile = "K:\IPM - CompOps\Ops Docs\avail-stats\Originals\" + Data
On Error GoTo Handler
vOurResult = Cells.Find(What:=curDate, LookAt:=xlWhole).Select
If (vOurResult = True) Then
MyRowNumber = ActiveCell.Row
Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
'MsgBox vOurResult
Row = ExcelLastCell.Row
col = ExcelLastCell.Column
' MsgBox curDate
Cells(ActiveCell.Row, ActiveCell.Column + 6).Select
comment = ActiveCell.Text
newline = Replace(comment, Chr(10), " ")
ActiveCell.Value = newline
For i = MyRowNumber To Row - 1
comment = ""
newline = ""
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
comment = ActiveCell.Text
newline = Replace(comment, Chr(10), " ")
ActiveCell.Value = newline
Next i
'MsgBox curDate
ActiveWorkbook.SaveAs FileName:=Myfile, FileFormat:=xlNormal
End If
oXL.Quit
Handler:
oXL.Quit
End Sub
Private Sub Form_Load()
Command1_Click
End
End Sub
Private Sub Label1_Click()
End Sub
You have these lines towards the end of the Sub:
oXL.Quit
Handler:
oXL.Quit
The second Quit call fails, generating the error. You need to exit the procedure just before the Handler (which will only be called in the event of an error):
oXL.Quit
Exit Sub
Handler:
oXL.Quit
That's because the code 'falls through' to your line-label called Handler.
Thus when your Handler then tries to call Method 'Quit' of object 'oXL', that will fail because oXL has already quit.
The obvious solution is to Exit Sub before it reaches the Handler.
The general layout for a Sub (from MSDN):
Sub InitializeMatrix(Var1, Var2, Var3, Var4)
On Error GoTo ErrorHandler
. . .
Exit Sub
ErrorHandler:
. . .
Resume Next
End Sub
Hope this helps!
EDIT:
Seems the original question that I was helping the asker with via chat was deleted and later re-posted (I assume to get some fresh page-views).
Although Andy G has already answered this re-post, I figured not to let my answer go to waste and posted it anyway, hoping the explanation and reference might help future readers.