有没有一种方法可以从Excel插件插入宏到工作表?

yizd12fk  于 2023-04-22  发布在  其他
关注(0)|答案(2)|浏览(151)

我搜索了Office Excel API文档,但根本找不到任何关于如何实现它的内容。
问题:
运气的API功能或某种错误可以很容易地解决VBA宏。
但是,要做到这一点,我们只有两种可能性:
1.手动将宏插入到工作表中,这将捕获工作表上的一些事件,来自插件的JS将触发该事件(这个解决方案来自非常古老的论坛(如果我会找到链接,我会在这里插入))。
1.通过JS代码向工作表插入宏(context.workbook.worksheet?),甚至它不能被插件执行,但在这种情况下,最终用户根本不需要管理宏-我们可以用同样的逻辑使宏运行的过程更流畅。(JS将宏插入到工作表中,改变工作表中的某个值,然后触发某个宏,之后(例如在JS中超时后或在JS中发生另一个事件后,我们可以轻松地使用此宏删除整个工作表)。
所以问题是,有没有可能使用API(某种从插件中插入/删除VBA代码的函数)以某种方式做出类似于解决方案2的东西?
我将感谢任何帮助!

举例说明问题

我使用的是JavaScript API,但不幸的是,API并没有涵盖VBA中已经存在的全部功能(我希望还没有)。让我用一个简单的例子来解释它:
想象一个任务:
1.我们需要从工作簿1中的工作表1复制一些信息
1.然后我们需要创建一本书,并将值放入新的工作簿2中
1.那么我们需要向用户建议它(新工作簿2)需要保存在哪里。
1.然后我们需要保存并关闭工作簿2。
VBA很容易解决这个问题,但如果JS API -没有这个问题的完整解决方案(没有第三方应用程序)。
您可以通过以下链接比较API JS和VBA:
Workbooks JS API
Workbooks VBA API
所以我想做的是-写实际的VBA宏在JavaScript和插入这个VBA宏到工作表,使宏可执行。

如何将工作表上的一些值更改为宏可执行?

我发现,如果你调用select方法直接应用于单元格,并在VBA中使用Worksheet_SelectionChange捕获选择更改-它可以完美地工作。
不幸的是,将值直接设置到单元格不会触发VBA Worksheet_change

为什么使用JS API

目前我已经有一个VBA项目类似的任务,但随着项目的发展和演变-一些功能在这里,一些功能在这里,我看到插件-是解决关键问题的最佳解决方案-它更容易维护,管理,开发,推送更新,安装,它只是看起来更好-因为插件只是一个简单的网站

更新2019/09/20 -可能的解决方案

首先,非常感谢@DecimalTurn,是他让这个解决方案成为可能。
我稍微修改了一下,并添加了额外的JS脚本和VBA脚本,使这个解决方案完整。所以:
1.在从JS到ThisWorkbook模块执行任何操作之前,需要插入以下VBA宏:
1.1. VBA宏,它将处理我们将要传输的所有VBA代码

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    On Error GoTo endline
    Const SheetName As String = "_WorksheetSheetWorker"

    CheckIfVBAAccessIsOn

    If InStr(1, Sh.name, SheetName, vbBinaryCompare) >= 0 Then
        If Sh.Range("$A$1") <> vbNullString Then

            Const ModuleName As String = "m_TempMacroJS"

            Dim ws As Worksheet
            Set ws = ThisWorkbook.Sheets(SheetName)
            'We will take MacroName from sheet which we added from JS
            Dim MacroName As String
            MacroName = ws.Range("A2").Value2

            Dim rng As Range
            Set rng = ws.Range("A1")
            Dim pathToMacroBas As String

            'Export the content of the cell to a .bas file
            pathToMacroBas = ThisWorkbook.path & "\" & ModuleName & ".bas"
            Open pathToMacroBas For Output As #1
            Print #1, "Attribute VB_Name = """ & ModuleName & """ " & vbNewLine & ws.Range("A1").Value2
            Close #1

            'Declare VBProject Object
            Dim vbaProject As VBProject
            Set vbaProject = ThisWorkbook.VBProject

            'Delete pre-existing module with the same name
            On Error Resume Next
            ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(ModuleName)
                On Error GoTo 0

                'Load the code as a new Module
                vbaProject.VBComponents.Import ThisWorkbook.path & "\" & ModuleName & ".bas"
                Dim vbaModule As VBIDE.VBComponent
                Set vbaModule = vbaProject.VBComponents(ModuleName)

                'Run the code and transfer working sheet to macro
                'You can use this worksheet to transfer values to macro as JSON
                Application.Run ModuleName & "." & MacroName, ws

                'Cleanup
                ThisWorkbook.VBProject.VBComponents.Remove vbaModule 
                'Optional
                Kill pathToMacroBas
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
            End If
        End If
        Exit Sub
      endline:
      End Sub

1.2 VBA宏将以编程方式启用Trust access to the VBA project object model。请注意:您还需要启用Microsoft Visual Basic for Applications Extensibility 5.3
我在链接here上找到了解决方案,并对其进行了一些修改-宏创建VBScript并直接在寄存器中启用Trust access to the VBA project object model。我无法处理的问题是延迟。延迟时间需要保存和关闭现有工作簿。

Sub CheckIfVBAAccessIsOn()

    '[HKEY_LOCAL_MACHINE/Software/Microsoft/Office/10.0/Excel/Security]
    '"AccessVBOM"=dword:00000001

    Dim strRegPath As String
    strRegPath = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM"

    If TestIfKeyExists(strRegPath) = False Then
      MsgBox "A change has been introduced into your registry configuration. All changes will be saved. Please reopen book."
      WriteVBS
      ThisWorkbook.Save
      Application.Quit
    End If

  End Sub

  Function TestIfKeyExists(ByVal path As String)
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    On Error Resume Next
    Dim RegValue As Boolean
    RegValue = WshShell.RegRead(path)
    If RegValue = True Then
      TestIfKeyExists = True
    Else
      TestIfKeyExists = False
    End If
    On Error GoTo 0
  End Function

  Sub WriteVBS()
    Dim objFile         As Object
    Dim objFSO          As Object
    Dim codePath        As String
    codePath = Me.path & "\reg_setting.vbs"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.OpenTextFile(codePath, 2, True)

    objFile.WriteLine (" On Error Resume Next")
    objFile.WriteLine ("")
    objFile.WriteLine ("Dim WshShell")
    objFile.WriteLine ("Set WshShell = CreateObject(""WScript.Shell"")")
    objFile.WriteLine ("")
    objFile.WriteLine ("MsgBox ""Please wait until Excel will closes! Click OK to complete the setup process.""")
    objFile.WriteLine ("")
    objFile.WriteLine ("Dim strRegPath")
    objFile.WriteLine ("Dim Application_Version")
    objFile.WriteLine ("Application_Version = """ & Application.Version & """")
    objFile.WriteLine ("strRegPath = ""HKEY_CURRENT_USER\Software\Microsoft\Office\"" & Application_Version & ""\Excel\Security\AccessVBOM""")
    objFile.WriteLine ("WScript.echo strRegPath")
    objFile.WriteLine ("WshShell.RegWrite strRegPath, 1, ""REG_DWORD""")
    objFile.WriteLine ("")
    objFile.WriteLine ("If Err.Code <> o Then")
    objFile.WriteLine ("   MsgBox ""Error"" & Chr(13) & Chr(10) & Err.Source & Chr(13) & Chr(10) & Err.Message")
    objFile.WriteLine ("End If")
    objFile.WriteLine ("")
    objFile.WriteLine ("WScript.Quit")

    objFile.Close
    Set objFile = Nothing
    Set objFSO = Nothing

    'run the VBscript code
    ' > The macro will fail to execute the VB script if you use a
    '   [codepath] which contains blanks!
    '
    ' > To fix this issue, we add a pair of double quotes (" ") around
    '   [codepath];
    Shell "cscript " & Chr(34) & codePath & Chr(34), vbNormalFocus

  End Sub

1.第二部分我基于@DecimalTurn建议在JS中创建工作表,然后从VBA捕获此事件并将整个代码 Package 在一个JS示例中:

const VBAWorker = function(){
      /* This is a name of tempurary sheet to execute macro */
      this._executedMacroName = "JSSubRunner"
      /* This is the name of sheet worker*/
      this._WorksheetSheetWorkerName = "_WorksheetSheetWorker"
      /* These options can be applied to already existed sheet*/
      this._worksheetExistenceDecisionOptions = {
        replaceSheet : "replaceSheet",
        findNewAvailableName : "findNewAvailableName"
      }
    }

    /**
     * Function to run macro using sheet worker
     * @param {String} VBAMacro is a code which will be executed
     * @param {String} transferredValues (optional) are a values which we need 
     * to place into executable macro
     * @param {String} worksheetDesicion (optional) is a desicion which we will if the worker worksheet exists
     * default = "replaceSheet", possible = "findNewAvailableName"
     */
    VBAWorker.prototype.run= async function(VBAMacro, transferredValues = "", worksheetDesicion = "replaceSheet"){
      const defaultWorksheetName = this._WorksheetSheetWorkerName
      let worksheetName = defaultWorksheetName
      const preparedVBAMacro = this._changeMacroName(VBAMacro) 
      await Excel.run(async (context) => {
        /* First we need to check out existence of sheet worker*/
        let sheets = context.workbook.worksheets;
        sheets.load("items/name");

        await context.sync()
        /**
         *  In this case we will deside what to do 
         *  if we will find sheet with the same name
         * */ 
        const isSheetExists = this._checkWorksheetExistence(sheets)
        const decisionOptions = this._worksheetExistenceDecisionOptions
        if (isSheetExists){
          switch (worksheetDesicion){
            case decisionOptions.replaceSheet:
              let sheetToReplace = sheets.getItem(worksheetName)
              sheetToReplace.delete()
              await context.sync()
            break;
            case decisionOptions.findNewAvailableName:
              worksheetName = this._changeNameOfWorkerWorksheet(sheets) 
            break;
          }
        } else {
          /* we will keep worksheetName as default */
        }

        let sheet = sheets.add(worksheetName);
        let macroExeCell = sheet.getCell(0,0)
        let macroNameCell = sheet.getCell(1,0)
        let macroValuesCell = sheet.getCell(0,1)
        macroExeCell.values = preparedVBAMacro
        macroNameCell.values = this._executedMacroName
        let preparedValues = []
        const limit = 32700 
        const lengthOfString = transferredValues.length
        // console.log(transferredValues.length)
        // console.log(transferredValues.length / limit)
          if (lengthOfString > limit) {
            try {
              let done = false

              /* during cell lenght limit we will slice string to many*/
              let lastStep = false
              let current = limit
              let oldcurrent = 0

              do {
                let end = current
                let start = oldcurrent
                /* Check that the next simbol not equals to "=" */
                if(transferredValues.slice(end, end + 1) == "="){
                  current += 1
                  end = current
                }

                if (lengthOfString < start ){
                  start = lengthOfString
                }  
                if (lengthOfString < end){
                  end = lengthOfString
                  lastStep = true
                }

                preparedValues.push(transferredValues.slice(start, end))

                if (lastStep){
                  done = true
                } else {
                  oldcurrent = current
                  current += limit
                }
              } while (done == false)
              /* Write values to sheet*/
              await preparedValues.forEach(async (el, i)=>{
                macroValuesCell = sheet.getCell(0 + i,1)
                macroValuesCell.values = [[el]]
              })
            } catch (error) {
              console.log(error)
            }
          } else {
            /* If string.length is less then limit we just put it directly to one cell*/
            macroValuesCell.values = [[transferredValues]]
          }
        return await context.sync();
      });
    }

    /**
     * Function to search available name of sheet and return it
     * @param {Array} sheets - worksheet items with 
     * returns suggestedName (string)
     */
    VBAWorker.prototype._changeNameOfWorkerWorksheet = function(sheets){
      try {
        let suggestCounter = 0
        let suggestedName; 
        let suggestedNameIsFree = false;
        let worksheetName = this._WorksheetSheetWorkerName
        do {
          suggestedName = worksheetName + suggestCounter 
          suggestCounter = suggestCounter +1
          suggestedNameIsFree = !this._checkWorksheetExistence(sheets)
        } while (suggestedNameIsFree = false);
        return suggestedName

      } catch (error) {
        console.log(error)
      }
    }

    /**
     * Function to check worksheet name existence
     * @param {Array} sheets - worksheet items with names
     * returns true or false
     */
    VBAWorker.prototype._checkWorksheetExistence = function(sheets){
      let isSheetExists = false
      sheets.items.forEach(el=>{
        if(el.name == this._WorksheetSheetWorkerName){
          isSheetExists = true
          return;
        }
      }) 
      return isSheetExists
    }

    /**
     * Function to change name of running macro
     * @param {String} VBAMacro is a string that contains executed macro
     * The name of running sub will be changed to "_JSSubRunner"
     */
    VBAWorker.prototype._changeMacroName =function(VBAMacro){
      const regex = /(Sub\s+)(.*)([(])/i
      const renamedVBAMacro = VBAMacro.replace(regex, `Sub ${this._executedMacroName} (`)
      return renamedVBAMacro
    }

    export default VBAWorker
  • 如何使用 *

您可以使用它作为简单的示例,以这种方式调用VBAWorker:

const VBAWorkerInst = new VBAWorker()
  await VBAWorkerInst.run(
    "your VBA code goes here",
    "your values in string (JSON for example) goes here",
    "optional option:) - a name of decision what we need to do, if sheet already existed"
  )

您的宏可以有任何名称,因为VBAWorker会处理它,并更改名称以统一它。

  • 请注意:* 因为Excel是异步的,所以我们需要等待所有的promise都被解析!所以上面的代码必须 Package 在异步函数中,或者你可以捕获promise回调。

我还没有测试过,但我认为运行多个宏是可能的,我们可以使用与值相同的策略来编写更有用的代码。
所以这一切都在这一刻:)真的希望随着时间的推移会有更简单的解决方案。

juud5qan

juud5qan1#

潜在解决方案

作为免责声明,此方法可能会在您正在使用的Excel文件中引入一些漏洞,因此您必须小心使用宏,模块和工作表名称的唯一名称,以确保没有加载项将在未经您同意的情况下运行VBA代码。
这个想法是创建一个新的工作表,并将宏的代码写入该工作表中的单元格(比如单元格A1)。然后,ThisWorkbook模块中已经存在VBA事件过程,它将完成繁重的工作,使宏运行。
假设已启用Trust access to the VBA project object model,并且已将Microsoft Visual Basic for Applications Extensibility 5.3库添加到工作簿中,则ThisWorkbook中可能有以下VBA事件过程:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    If Sh.Name = "NewSheet" Then
        If Sh.Range("$A$1") <> vbNullString Then
            
            Const ModuleName As String = "MacroJs"
            Const MacroName As String = "YourMacroName"
            Const SheetName As String = "NewSheet"
            
            Dim ws As Worksheet
            Set ws = ThisWorkbook.Sheets(SheetName)
            
            Dim rng As Range
            Set rng = ws.Range("A1")
            
            'Export the content of the cell to a .bas file
            Open ThisWorkbook.Path & "\" & ModuleName & ".bas" For Output As #1
            Print #1, "Attribute VB_Name = """ & ModuleName & """ " & vbNewLine & ws.Range("A1").Value2
            Close #1
            
            'Declare VBProject Object
            Dim vbaProject As VBProject
            Set vbaProject = ThisWorkbook.VBProject
            
            'Delete pre-existing module with the same name
            On Error Resume Next
            ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(ModuleName)
            On Error GoTo 0
            
            'Load the code as a new Module
            vbaProject.VBComponents.Import ThisWorkbook.Path & "\" & ModuleName & ".bas"
            Dim vbaModule As VBIDE.VBComponent
            Set vbaModule = vbaProject.VBComponents(ModuleName)
            
            'Run the code
            Application.Run ModuleName & "." & MacroName
            
            'Cleanup
            ThisWorkbook.VBProject.VBComponents.Remove vbaModule 'Optional
            Application.DisplayAlerts = False
                ws.Delete
            Application.DisplayAlerts = True
        End If
    End If
End Sub

此过程将由您的Office-JS代码创建工作表触发。
请注意,我还建议添加一些错误处理,以确保在运行代码时出现运行时错误时会运行cleanup部分。
然后你的JavaScript代码看起来像这样:

var sheets = context.workbook.worksheets;
var sheet = sheets.add("NewSheet");
sheet.getRange("A1").values = [['sub YourMacroName() \n Msgbox "Test" \n End sub']];
rta7y2nd

rta7y2nd2#

嗨,这个功能目前还没有Office.js API。我会在Office加载项用户语音网站上发布一个要求:https://officespdev.uservoice.com谢谢

相关问题