| Quellcodebibliothek Statistik Leitseite products/Sources/formale Sprachen/C/LibreOffice/wizards/source/access2base/ (Office von Apache Version 25.8.3.2©) Datei vom 5.10.2025 mit Größe 27 kB |
|
Quelle Python.xba Sprache: unbekannt |
|
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Python REM ============================================================================= REM === The Access2Base library is a part of the LibreOffice project. === REM === Full documentation is available on http://www.access2base.com === REM ============================================================================= Option Compatible Option Explicit REM ----------------------------------------------------------------------------- Public Sub DebugPrint(ParamArray pvArgs() As Variant) 'Print arguments unconditionally in console 'Arguments are separated by a TAB (simulated by spaces) 'Some pvArgs might be missing: a TAB is still generated Dim vVarTypes() As Variant, i As Integer Const cstTab = 5 On Local Error Goto Exit_Sub ' Never interrupt processing Utils._SetCalledSub("DebugPrint") vVarTypes = Utils._AddNumeric(Array(vbEmpty, vbNull, vbDate, vbString, vbBoolean, vbObj If UBound(pvArgs) >= 0 Then For i = 0 To UBound(pvArgs) If Not Utils._CheckArgument(pvArgs(i), i + 1, vVarTypes(), , False) Then pvArgs(i) = "[TYPE?]" Next i End If Dim sOutput As String, sArg As String sOutput = "" For i = 0 To UBound(pvArgs) sArg = Replace(Utils._CStr(pvArgs(i), _A2B_.DebugPrintShort), "\;", ";") ' Add argument to output If i = 0 Then sOutput = sArg Else sOutput = sOutput & Space(cstTab - (Len(sOutput) Mod cstTab)) & sArg End If Next i TraceLog(TRACEANY, sOutput, False) Exit_Sub: Utils._ResetCalledSub("DebugPrint") Exit Sub End Sub ' DebugPrint V0.9.5 REM ----------------------------------------------------------------------------- REM --- PYTHON WRAPPERS --- REM ----------------------------------------------------------------------------- REM ----------------------------------------------------------------------------- Public Function PythonEventsWrapper(Optional poEvent As Variant) As Variant ' Python wrapper when Application.Events() method is invoked ' The ParamArray mechanism empties UNO objects when they are member of the arguments list ' As a workaround, the Application.Events function is executed directly If _ErrorHandler() Then On Local Error GoTo Exit_Function ' Do never interrupt PythonEventsWrapper = Null Dim vReturn As Variant, vArray As Variant Const cstObject = 1 vReturn = Application.Events(poEvent) vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type) PythonEventsWrapper = vArray Exit_Function: Exit Function End Function ' PythonEventsWrapper V6.4 REM ----------------------------------------------------------------------------- Public Function PythonWrapper(ByVal pvCallType As Variant _ , ByVal pvObject As Variant _ , ByVal pvScript As Variant _ , ParamArray pvArgs() As Variant _ ) As Variant ' Called from Python to apply ' - on object with entry pvObject in PythonCache ' Conventionally: -1 = Application ' -2 = DoCmd ' - a script pvScript which type is described by pvCallType ' - with arguments pvArgs(0)... (max. 8 for object methods) ' The value returned by the method/property is encapsulated in an array ' [0] => 0 = scalar or array returned by the method ' => 1 = basic object returned by the method ' => 2 = a null value ' [1] => the object reference or the returned value (complemented with arguments passed by refere ' [2] => the object type or Null ' [3] => the object name, if any ' or, when pvCallType == vbUNO, as the UNO object returned by the property Dim vReturn As Variant, vArray As Variant Dim vObject As Variant, sScript As String, sModule As String Dim i As Integer, iNbArgs As Integer, vArg As Variant, vArgs() As Variant Const cstApplication = -1, cstDoCmd = -2 Const cstScalar = 0, cstObject = 1, cstNull = 2, cstUNO = 3 'Conventional special values Const cstNoArgs = "+++NOARGS+++", cstSymEmpty = "+++EMPTY+++", cstSymNull = "+++NULL+++", cstSym 'https://support.office.com/en-us/article/CallByName-fonction-49ce9475-c315-4f13- 'Determines the pvCallType Const vbGet = 2, vbLet = 4, vbMethod = 1, vbSet = 8, vbUNO = 16 If _ErrorHandler() Then On Local Error GoTo Error_Function PythonWrapper = Null 'Reinterpret arguments one by one into vArgs, examine iso-dates and conventional NoArgs/Empt iNbArgs = -1 vArgs = Array() If UBound(pvArgs) >= 0 Then For i = 0 To UBound(pvArgs) vArg = pvArgs(i) If i = 0 And VarType(vArg) = vbString Then If vArg = cstNoArgs Then Exit For End If If VarType(vArg) = vbString Then If vArg = cstSymEmpty Then vArg = Empty ElseIf vArg = cstSymNull Then vArg = Null ElseIf vArg = cstSymMissing Then Exit For ' Next arguments must be missing also Else vArg = _CDate(vArg) End If End If iNbArgs = iNbArgs + 1 ReDim Preserve vArgs(iNbArgs) vArgs(iNbArgs) = vArg Next i End If 'Check pvObject Select Case pvObject ' Always numeric Case cstApplication sModule = "Application" Select Case pvScript Case "AllDialogs" : If iNbArgs < 0 Then vReturn = Application.AllDialogs() Else vReturn = Applica Case "AllForms" : If iNbArgs < 0 Then vReturn = Application.AllForms() Else vReturn = Application Case "AllModules" : If iNbArgs < 0 Then vReturn = Application.AllModules() Else vReturn = Applica Case "CloseConnection" vReturn = Application.CloseConnection() Case "CommandBars" : If iNbArgs < 0 Then vReturn = Application.CommandBars() Else vReturn = Appli Case "CurrentDb" : vReturn = Application.CurrentDb() Case "CurrentUser" : vReturn = Application.CurrentUser() Case "DAvg" : vReturn = Application.DAvg(vArgs(0), vArgs(1), vArgs(2)) Case "DCount" : vReturn = Application.DCount(vArgs(0), vArgs(1), vArgs(2)) Case "DLookup" : vReturn = Application.DLookup(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "DMax" : vReturn = Application.DMax(vArgs(0), vArgs(1), vArgs(2)) Case "DMin" : vReturn = Application.DMin(vArgs(0), vArgs(1), vArgs(2)) Case "DStDev" : vReturn = Application.DStDev(vArgs(0), vArgs(1), vArgs(2)) Case "DStDevP" : vReturn = Application.DStDevP(vArgs(0), vArgs(1), vArgs(2)) Case "DSum" : vReturn = Application.DSum(vArgs(0), vArgs(1), vArgs(2)) Case "DVar" : vReturn = Application.DVar(vArgs(0), vArgs(1), vArgs(2)) Case "DVarP" : vReturn = Application.DVarP(vArgs(0), vArgs(1), vArgs(2)) Case "Forms" : If iNbArgs < 0 Then vReturn = Application.Forms() Else vReturn = Application.Forms Case "getObject" : vReturn = Application.getObject(vArgs(0)) Case "getValue" : vReturn = Application.getValue(vArgs(0)) Case "HtmlEncode" : vReturn = Application.HtmlEncode(vArgs(0), vArgs(1)) Case "OpenDatabase" : vReturn = Application.OpenDatabase(vArgs(0), vArgs(1), vArgs(2), vAr Case "ProductCode" : vReturn = Application.ProductCode() Case "setValue" : vReturn = Application.setValue(vArgs(0), vArgs(1)) Case "SysCmd" : vReturn = Application.SysCmd(vArgs(0), vArgs(1), vARgs(2)) Case "TempVars" : If iNbArgs < 0 Then vReturn = Application.TempVars() Else vReturn = Application Case "Version" : vReturn = Application.Version() Case Else GoTo Error_Proc End Select Case cstDoCmd sModule = "DoCmd" Select Case pvScript Case "ApplyFilter" : vReturn = DoCmd.ApplyFilter(vArgs(0), vArgs(1), vArgs(2)) Case "Close" : vReturn = DoCmd.mClose(vArgs(0), vArgs(1), vArgs(2)) Case "CopyObject" : vReturn = DoCmd.CopyObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "FindNext" : vReturn = DoCmd.FindNext() Case "FindRecord" : vReturn = DoCmd.FindRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArg Case "GetHiddenAttribute" vReturn = DoCmd.GetHiddenAttribute(vArgs(0), vArgs(1)) Case "GoToControl" : vReturn = DoCmd.GoToControl(vArgs(0)) Case "GoToRecord" : vReturn = DoCmd.GoToRecord(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "Maximize" : vReturn = DoCmd.Maximize() Case "Minimize" : vReturn = DoCmd.Minimize() Case "MoveSize" : vReturn = DoCmd.MoveSize(vArgs(0), vArgs(1), vArgs(2), vArgs(3)) Case "OpenForm" : vReturn = DoCmd.OpenForm(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4) Case "OpenQuery" : vReturn = DoCmd.OpenQuery(vArgs(0), vArgs(1), vArgs(2)) Case "OpenReport" : vReturn = DoCmd.OpenReport(vArgs(0), vArgs(1)) Case "OpenSQL" : vReturn = DoCmd.OpenSQL(vArgs(0), vArgs(1)) Case "OpenTable" : vReturn = DoCmd.OpenTable(vArgs(0), vArgs(1), vArgs(2)) Case "OutputTo" : vReturn = DoCmd.OutputTo(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArgs(4) Case "Quit" : _A2B_.CalledSub = "Quit" : GoTo Error_Action Case "RunApp" : vReturn = DoCmd.RunApp(vArgs(0)) Case "RunCommand" : vReturn = DoCmd.RunCommand(vArgs(0)) Case "RunSQL" : vReturn = DoCmd.RunSQL(vArgs(0), vArgs(1)) Case "SelectObject" : vReturn = DoCmd.SelectObject(vArgs(0), vArgs(1), vArgs(2)) Case "SendObject" : vReturn = DoCmd.SendObject(vArgs(0), vArgs(1), vArgs(2), vArgs(3), vArg Case "SetHiddenAttribute" vReturn = DoCmd.SetHiddenAttribute(vArgs(0), vArgs(1), vArgs(2)) Case "SetOrderBy" : vReturn = DoCmd.SetOrderBy(vArgs(0), vArgs(1)) Case "ShowAllRecords" vReturn = DoCmd.ShowAllRecords() Case Else GoTo Error_Proc End Select Case Else ' Locate targeted object If pvObject > UBound(_A2B_.PythonCache) Or pvObject < 0 Then GoTo Error_Object Set vObject = _A2B_.PythonCache(pvObject) If IsNull(vObject) Then If pvScript = "Dispose" Then GoTo Exit_Function Else GoTo Error_Object End If ' Preprocessing sScript = pvScript sModule = vObject._Type Select Case sScript Case "Add" If vObject._Type = "COLLECTION" And vObject._CollType = COLLTABLEDEFS Then vArgs = Array(_A2B Case "Close" sSCript = "mClose" Case "Type" sScript = "pType" Case Else End Select ' Execute method Select Case UBound(vArgs) ' Dirty but ... CallByName does not support an array of arguments or re Case -1 If pvCallType = vbUNO Then With vObject Select Case sScript ' List all properties that should be called directly (UNO) Case "BoundField" : vReturn = .BoundField Case "Column" : vReturn = .Column Case "Connection" : vReturn = .Connection case "ContainerWindow" : vReturn = .ContainerWindow Case "ControlModel" : vReturn = .ControlModel Case "ControlView" : vReturn = .ControlView Case "DatabaseForm" : vReturn = .DatabaseForm Case "Document" : vReturn = .Document Case "FormsCollection" : vReturn = .FormsCollection Case "LabelControl" : vReturn = .LabelControl Case "MetaData" : vReturn = .MetaData Case "ParentComponent" : vReturn = .ParentComponent Case "Query" : vReturn = .Query Case "RowSet" : vReturn = .RowSet Case "Table" : vReturn = .Table Case "UnoDialog" : vReturn = .UnoDialog Case Else End Select End With ElseIf sScript = "ItemData" Then ' List all properties that should be called directly (arrays not s vReturn = vObject.ItemData ElseIf sScript = "LinkChildFields" Then vReturn = vObject.LinkChildFields ElseIf sScript = "LinkMasterFields" Then vReturn = vObject.LinkMasterFields ElseIf sScript = "OpenArgs" Then vReturn = vObject.OpenArgs ElseIf sScript = "Selected" Then vReturn = vObject.Selected ElseIf sScript = "Value" Then vReturn = vObject.Value Else vReturn = CallByName(vObject, sScript, pvCallType) End If Case 0 Select Case sScript Case "AppendChunk" ' Arg is a vector, not supported by CallByName vReturn = vObject.GetChunk(vArgs(0), vArgs(1)) Case "GetRows" ' Returns an array, not supported by CallByName vReturn = vObject.GetRows(vArgs(0), True) ' Force iso dates Case Else vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0)) End Select Case 1 Select Case sScript Case "GetChunk" ' Returns a vector, not supported by CallByName vReturn = vObject.GetChunk(vArgs(0), vArgs(1)) Case Else vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1)) End Select Case 2 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2)) Case 3 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), v Case 4 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), v Case 5 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), v Case 6 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), v Case 7 : vReturn = CallByName(vObject, sScript, pvCallType, vArgs(0), vArgs(1), vArgs(2), v End Select ' Postprocessing Select Case pvScript Case "Close", "Dispose", "Terminate" Set _A2B_.PythonCache(pvObject) = Nothing Case "Move", "MoveFirst", "MoveLast", "MoveNext", "MovePrevious" ' Pass the new BOF, EOF values (binary f If vObject._Type = "RECORDSET" Then vReturn = (Iif(vObject.BOF, 1, 0) * 2 + Iif(vObject.EOF, 1, 0)) * Iif(vReturn, 1, -1) End If Case "Find" ' Store in array the arguments passed by reference If vObject._Type = "MODULE" And vReturn = True Then vReturn = Array(vReturn, vArgs(1), vArgs(2), vArgs(3), vArgs(4)) End If Case "ProcOfLine" ' Store in array the arguments passed by reference vReturn = Array(vReturn, vArgs(1)) Case Else End Select End Select ' Structure the returned array If pvCallType = vbUNO Then vArray = vReturn Else If IsNull(vReturn) Then vArray = Array(cstNull, Null, Null) ElseIf IsObject(vReturn) Then Select Case vReturn._Type Case "COLLECTION", "COMMANDBARCONTROL", "EVENT" vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type) Case Else vArray = Array(cstObject, _A2B_.AddPython(vReturn), vReturn._Type, vReturn.Name) End Select Else If VarType(vReturn) = vbDate Then vArray = Array(cstScalar, _CStr(vReturn), Null) ElseIf VarType(vReturn) = vbBigint Then ' Could happen for big integer database fields vArray = Array(cstScalar, CLng(vReturn), Null) Else vArray = Array(cstScalar, vReturn, Null) End If End If End If PythonWrapper = vArray Exit_Function: Exit Function Error_Function: TraceError(TRACEABORT, Err, "PythonWrapper", Erl) GoTo Exit_Function Error_Object: TraceError(TRACEFATAL, ERROBJECTNOTFOUND, "Python Wrapper (" & pvScript & ")", 0, , Array(_GetLab GoTo Exit_Function Error_Action: TraceError(TRACEFATAL, ERRACTION, Utils._CalledSub(), 0) GoTo Exit_Function Error_Proc: TraceError(TRACEFATAL, ERRPROCEDURENOTFOUND, "Python Wrapper", 0, , Array(pvScript, sModu GoTo Exit_Function End Function ' PythonWrapper V6.4 REM ----------------------------------------------------------------------------- REM --- PYTHON HELPER FUNCTIONS --- REM ----------------------------------------------------------------------------- REM ----------------------------------------------------------------------------- Public Function PyConvertFromUrl(ByVal pvFile As Variant) As String ' Convenient function to have common conversions of filenames from/to url notations both in Pyt On Local Error GoTo Exit_Function PyConvertFromUrl = "" If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function PyConvertFromUrl = ConvertFromUrl(pvFile) Exit_Function: Exit Function End Function ' PyConvertFromUrl V6.4 REM ----------------------------------------------------------------------------- Public Function PyConvertToUrl(ByVal pvFile As Variant) As String ' Convenient function to have common conversions of filenames from/to url notations both in Pyt On Local Error GoTo Exit_Function PyConvertToUrl = "" If Not Utils._CheckArgument(pvFile, 1, vbString) Then Goto Exit_Function PyConvertToUrl = ConvertToUrl(pvFile) Exit_Function: Exit Function End Function ' PyConvertToUrl V6.4 REM ----------------------------------------------------------------------------- Public Function PyCreateUnoService(ByVal pvService As Variant) As Variant ' Convenient function to create a UNO service in Python On Local Error GoTo Exit_Function Set PyCreateUnoService = Nothing If Not Utils._CheckArgument(pvService, 1, vbString) Then Goto Exit_Function Set PyCreateUnoService = CreateUnoService(pvService) Exit_Function: Exit Function End Function ' PyCreateUnoService V6.4 REM ----------------------------------------------------------------------------- Public Function PyDateAdd(ByVal pvAdd As Variant _ , ByVal pvCount As Variant _ , ByVal pvDate As Variant _ ) As Variant ' Convenient shortcut to useful and easy-to-use Basic date functions Dim vDate As Variant, vNewDate As Variant On Local Error GoTo Exit_Function PyDateAdd = Null If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvCount, 2, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvDate, 3, vbString) Then Goto Exit_Function vDate = _CDate(pvDate) vNewDate = DateAdd(pvAdd, pvCount, vDate) If VarType(vNewDate) = vbDate Then PyDateAdd = _CStr(vNewDate) Else PyDateAdd = vNewDate Exit_Function: Exit Function End Function ' PyDateAdd V6.4 REM ----------------------------------------------------------------------------- Public Function PyDateDiff(ByVal pvAdd As Variant _ , ByVal pvDate1 As Variant _ , ByVal pvDate2 As Variant _ , ByVal pvWeekStart As Variant _ , ByVal pvYearStart As Variant _ ) As Variant ' Convenient shortcut to useful and easy-to-use Basic date functions Dim vDate1 As Variant, vDate2 As Variant On Local Error GoTo Exit_Function PyDateDiff = Null If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvDate1, 2, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvDate2, 3, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Functio If Not Utils._CheckArgument(pvWeekStart, 5, Utils._AddNumeric()) Then Goto Exit_Functio vDate1 = _CDate(pvDate1) vDate2 = _CDate(pvDate2) PyDateDiff = DateDiff(pvAdd, vDate1, vDate2, pvWeekStart, pvYearStart) Exit_Function: Exit Function End Function ' PyDateDiff V6.4 REM ----------------------------------------------------------------------------- Public Function PyDatePart(ByVal pvAdd As Variant _ , ByVal pvDate As Variant _ , ByVal pvWeekStart As Variant _ , ByVal pvYearStart As Variant _ ) As Variant ' Convenient shortcut to useful and easy-to-use Basic date functions Dim vDate As Variant On Local Error GoTo Exit_Function PyDatePart = Null If Not Utils._CheckArgument(pvAdd, 1, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvDate, 2, vbString) Then Goto Exit_Function If Not Utils._CheckArgument(pvWeekStart, 3, Utils._AddNumeric()) Then Goto Exit_Functio If Not Utils._CheckArgument(pvWeekStart, 4, Utils._AddNumeric()) Then Goto Exit_Functio vDate = _CDate(pvDate) PyDatePart = DatePart(pvAdd, vDate, pvWeekStart, pvYearStart) Exit_Function: Exit Function End Function ' PyDatePart V6.4 REM ----------------------------------------------------------------------------- Public Function PyDateValue(ByVal pvDate As Variant) As Variant ' Convenient shortcut to useful and easy-to-use Basic date functions Dim vDate As Variant On Local Error GoTo Exit_Function PyDateValue = Null If Not Utils._CheckArgument(pvDate, 1, vbString) Then Goto Exit_Function vDate = DateValue(pvDate) If VarType(vDate) = vbDate Then PyDateValue = _CStr(vDate) Else PyDateValue = vDate Exit_Function: Exit Function End Function ' PyDateValue V6.4 REM ----------------------------------------------------------------------------- Public Function PyFormat(ByVal pvValue As Variant, pvFormat As Variant) As String ' Convenient function to format numbers or dates On Local Error GoTo Exit_Function PyFormat = "" If Not Utils._CheckArgument(pvValue, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Fun pvValue = _CDate(pvValue) If IsEmpty(pvFormat) Then PyFormat = Str(pvValue) Else If Not Utils._CheckArgument(pvFormat, 2, vbString) Then Goto Exit_Function PyFormat = Format(pvValue, pvFormat) End If Exit_Function: Exit Function End Function ' PyFormat V6.4 REM ----------------------------------------------------------------------------- Public Function PyGetGUIType() As Variant PyGetGUIType = GetGUIType() End Function ' PyGetGUIType V6.4 REM ----------------------------------------------------------------------------- Public Function PyGetSystemTicks() As Variant PyGetSystemTicks = GetSystemTicks() End Function ' PyGetSystemTicks V6.4 REM ----------------------------------------------------------------------------- Public Function PyGlobalScope(ByVal pvLib As Variant) As Variant Select Case pvLib Case "Basic" PyGlobalScope = GlobalScope.BasicLibraries() Case "Dialog" PyGlobalScope = GlobalScope.DialogLibraries() Case Else End Select End Function ' PyGlobalScope V6.4 REM ----------------------------------------------------------------------------- Public Function PyInputBox(ByVal pvText As Variant _ , ByVal pvTitle As Variant _ , ByVal pvDefault As Variant _ , ByVal pvXPos As Variant _ , ByVal pvYPos As Variant _ ) As Variant ' Convenient function to open input box from Python On Local Error GoTo Exit_Function PyInputBox = Null If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function If IsEmpty(pvTitle) Then pvTitle = "" If Not Utils._CheckArgument(pvTitle, 2, vbString) Then Goto Exit_Function If IsEmpty(pvDefault) Then pvDefault = "" If Not Utils._CheckArgument(pvDefault, 3, vbString) Then Goto Exit_Function If IsEmpty(pvXPos) Or IsEmpty(pvYPos) Then PyInputBox = InputBox(pvText, pvTitle, pvDefault) Else If Not Utils._CheckArgument(pvXPos, 4, Utils._AddNumeric()) Then Goto Exit_Function If Not Utils._CheckArgument(pvYPos, 5, Utils._AddNumeric()) Then Goto Exit_Function PyInputBox = InputBox(pvText, pvTitle, pvDefault, pvXPos, pvYPos) End If Exit_Function: Exit Function End Function ' PyInputBox V6.4.0 REM ----------------------------------------------------------------------------- Public Function PyMsgBox(ByVal pvText As Variant _ , ByVal pvType As Variant _ , ByVal pvDialogTitle As Variant _ ) As Variant ' Convenient function to open message box from Python On Local Error GoTo Exit_Function PyMsgBox = Null If Not Utils._CheckArgument(pvText, 1, vbString) Then Goto Exit_Function If IsEmpty(pvType) Then pvType = 0 If Not Utils._CheckArgument(pvType, 2, Utils._AddNumeric()) Then Goto Exit_Function If IsEmpty(pvDialogTitle) Then PyMsgBox = MsgBox(pvText, pvType) Else If Not Utils._CheckArgument(pvDialogTitle, 3, vbString) Then Goto Exit_Function PyMsgBox = MsgBox(pvText, pvType, pvDialogTitle) End If Exit_Function: Exit Function End Function ' PyMsgBox V6.4.0 REM ----------------------------------------------------------------------------- Public Function PyTimer() As Long ' Convenient function to call Timer from Python PyTimer = Timer End Function ' PyTimer V6.4 REM ----------------------------------------------------------------------------- REM --- PRIVATE FUNCTIONS --- REM ----------------------------------------------------------------------------- REM ----------------------------------------------------------------------------- Private Function _CDate(ByVal pvValue As Variant) As Variant ' Return a Date type if iso date, otherwise return input Dim vValue As Variant vValue = pvValue If VarType(pvValue) = vbString Then If pvValue <> "" And IsDate(pvValue) Then vValue = CDate(pvValue) ' IsDate("") gives True !? End If _CDate = vValue End Function </script:module> [ Dauer der Verarbeitung: 0.77 Sekunden (vorverarbeitet) ] |
2026-04-02