Question

我想从具有参数的vbscript调用vba函数，我知道如何调用参数化的子控件，但是函数出现问题

这是我尝试过的内容，我在这里Calling vba function(with parameters) from vbscript and show the result尝试了代码，但这也没有用，它在声明的结尾处出现了错误

SAPUI5

这是我的vba功能

import os

from PyQt5 import uic
from PyQt5 import QtWidgets
from qgis.core import *
from qgis.core import QgsProject

FORM_CLASS, _ = uic.loadUiType(os.path.join(
   os.path.dirname(__file__), 'Prototype_dialog_base.ui'))


class Prototypev1Dialog(QtWidgets.QDialog, FORM_CLASS):
  def __init__(self, parent=None):
    super(Prototypev1Dialog, self).__init__(parent)
    self.setupUi(self)

    self.pushButton.clicked.connect(self.openVector)
    self.pushButton_2.clicked.connect(self.SaveSelection)
    self.pushButton_3.clicked.connect(self.openSel)

 def openVector(self):
    dirlayer = QgsVectorLayer('C:/Users/PC/Desktop/Data Qgis/OSM/gis_osm_places_free_1.shp', 'test', 'ogr')
    QgsProject.instance().addMapLayer(dirlayer)

 def SaveSelection(self):
    #curlayer = qgis.utils.iface.activeLayer()
    curlayer = self.iface.activeLayer()
    _writer = QgsVectorFileWriter.writeAsVectorFormat(curlayer, 'C:/Users/PC/Desktop/Extract/testExtract.shp', "UTF-8",
                                                      curlayer.crs(), "ESRI Shapefile", onlySelected=True)

 def openSel(self):
    sellayer = QgsVectorLayer('C:/Users/PC/Desktop/Extract/testExtract.shp', 'extract', 'ogr')
    QgsProject.instance().addMapLayer(sellayer)

Answer 1

在您的VBScript中将xlObj设置为应用程序Set xlObj = CreateObject("Excel.Application")。这意味着xlObj.Application仅应为xlObj。

在您的VBScript中Filename没有声明也没有设置为值，因此为空。您需要为其定义值。

Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")

xlObj.Visible = False
xlObj.Workbooks.Add

Dim Filename 'declare filename and set a value to it
Filename = "E:\YourPath\Yourfile.xlsx"        

Dim Result
Result = xlObj.Run("Headers.xlsm!Headers", Filename)

xlFile.Close True
xlObj.Quit

在您的函数中使用Exit Function。这将立即停止代码，这意味着您的工作簿myWb将不会关闭！它保持打开状态，因为从未达到myWb.Close。将Exit Function更改为Exit For以退出循环并继续关闭工作簿。
Cells(1, i).Value既未指定在哪个工作簿中，也不在哪个工作表中。这不是很可靠，不要在未指定工作簿和工作表的情况下调用Cells或Range（否则Excel会猜测您的意思是哪个，如果不精确，Excel可能会失败）。

因此，如果您始终是该工作簿中的第一个工作表，则建议使用类似myWb.Worksheets(1).Cells(1, i).Value的名称。另外，如果使用定义的名称来定义名称，则会更可靠：myWb.Worksheets("SheetName").Cells(1, i).Value
如果您关闭ScreenUpdating，请不要忘记最后打开它。
在不存在文件名的情况下进行错误处理将很可能不会破坏该功能。

通过将Headers = "True"设为默认值，并稍稍提高速度即可，只要找到任何不匹配的标头，只需将其设为False即可。这样，变量仅被设置为True一次，而不是为每个正确的标头设置多次。

Public Function Headers(ByVal Filename As String) As String    
    Application.ScreenUpdating = False

    Dim flag As Boolean 'flag is never used! you can remove it

    On Error Resume Next 'error handling here would be nice to not break if filename does not exist.
    Dim myWb As Workbook
    Set myWb = Workbooks.Open(Filename:=Filename) 
    On Error Goro 0 'always reactivate error reporting after Resume Next!!!

    If Not myWb Is Nothing Then            
        Dim Arr() As Variant
        Arr = Array("col1", "col2")

        Headers = "True" 'assume True as default and just change it to False if a non matching header was found (faster because variable is only set true once instead for every column).
        Dim i As Long 'better use Long since there is no benefit in using Integer
        For i = 1 To UBound(arr) + 1 'use `ubound to find the upper index of the array, so if you add col3 you don't need to change the loop boundings
            If Not myWb.Worksheets(1).Cells(1, i).Value = Arr(i - 1) Then 'define workbook and worksheet for cells
                 Headers = "False , Not Found Header " & Arr(i - 1)
                 Exit For '<-- just exit loop but still close the workbook
            End If
        Next i
    Else
        Headers = "File '" & Filename & "' not found!"
    End If

    Application.ScreenUpdating = True
    myWb.Close
End Function

将参数从VbScript传递到vba函数

1 个答案: