以编程方式导出VBA模块

时间:2016-11-17 08:12:15

标签: java vba vbscript

要在不同的PowerPoint文件之间传输VBA宏,我可以将模块导出为BAS文件,然后将其导入另一个文件。但这必须手动完成。

我的Java 1.8应用程序将使用Apache POI自动生成新的PowerPoint文件,然后调用VBScript。该脚本将通过命令行从Java应用程序接收参数,然后打开创建的PowerPoint文件并调用宏,最后将参数传递给宏。

在所有可能发生之前,我需要先将模板PowerPoint文件中的多个宏自动导入到新创建的文件中。如何使用Java或VBS进行此操作?

编辑:如果您因为过于宽泛而要关闭它,您至少可以告诉我它的具体程度如何吗?因为据我所知,我已经非常明确地说明了我想要实现的目标。这是我第一次使用VBA或VBS进行编码,因此我不知道我对此主题的期望是什么,特别是"。

1 个答案:

答案 0 :(得分:0)

将所有模块从1个母本文件导出到另一个.xlsm文件:

  1. 如果包含母宏的工作簿位于文件夹中: "一个../"
  2. 然后将子办公室文件放在: "一个../ /接收/
  3. 并创建一个(n空)子文件夹: "一个../ /接收/模块
  4. 在MS Office中打开应用程序编辑器的VBA,单击"工具>参考"并标记复选框:" Microsoft Scripting Runtime"
  5. 接下来,创建两个模块,

    1. MODULEX:
    2. 。(如果我删除这个点,格式化为listmode,代码将不再是4个空格后的代码,如果有人可以解释如何在列表中粘贴大的代码块,你可以让我开心)

      Sub Update_Workbooks()
      'This macro requires that a reference to Microsoft Scripting Routine
      'be selected under Tools\References in order for it to work.
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      Dim fso As New FileSystemObject
      Dim source As Scripting.Folder
      Dim wbfile As Scripting.File
      Dim book As Excel.Workbook
      Dim sheet As Excel.Worksheet
      Dim Filename As String
      Dim ModuleFile As String
      Dim Element As Object
      Dim return_user_input As Integer
      
      
      'Set source = fso.GetFolder("C:\Users\Desktop\Testing")   'we will know this since all of the files will be in one folder
      Set source = fso.GetFolder(ThisWorkbook.Path & "\receiving")   'we will know this since all of the files will be in one folder
      For Each wbfile In source.Files
      
          Call basic_messagebox(wbfile, return_user_input)
          If return_user_input = 6 Then
              MsgBox (wbfile.name & " yes")
      
              'For Each wbFile In source.Files
      
              If fso.GetExtensionName(wbfile.name) = "xlsm" Then  'we will konw this too. All files will be .xlsm
                  'Call basic_messagebox
                  'Set book = Workbooks.Open(wbFile.Path)
                  Set book = Workbooks.Open(wbfile.Path)
                      Filename = FileNameOnly(wbfile.name)
                      'This will remove all modules including ClassModules and UserForms.
                      'It will keep all object modules like (sheets, ThisWorkbook)
                      'On Error Resume Next
                      Workbooks(wbfile.name).Activate
                      'For Each Element In ActiveWorkbook.VBProject.VBComponents
                      'On Error Resume Next
                      Call DeleteAllCode(wbfile)
      '                For Each Element In Workbooks(wbfile.name).VBProject.VBComponents
      '                    'ActiveWorkbook.VBProject.VBComponents.Remove Element
      '                    Workbooks(wbfile.name).VBProject.VBComponents.Remove Element
      '
      '                Next
      '                For Each Module In Workbooks(wbfile.name).VBProject.VBComponents
      '                    Workbooks(wbfile.name).VBProject.VBComponents.Remove Module
      '                Next
      
                      'On Error GoTo ErrHandle
                  '   Export Module1 from updating workbook
                      'ModuleFile = Application.DefaultFilePath & "\tempmodxxx.bas"
                      ModuleFile = ThisWorkbook.Path & "\receiving\modules" & "\tempmodxxx.bas"
      
      '                Workbooks("Update Multiple Workbooks.xlsm").VBProject.VBComponents("Module1") _
      '                .Export ModuleFile
                      'On Error Resume Next
                      For Each Module In ThisWorkbook.VBProject.VBComponents
                          'MsgBox (Module.name)
                          If Left(Module.name, 5) <> "Sheet" Then
                              If Left(Module.name, 6) = "Module" Then
                                  'MsgBox ("the modules name = " & Module.name)
                                  'ThisWorkbook.VBProject.VBComponents("Module1").Export ModuleFile
                                  ThisWorkbook.VBProject.VBComponents(Module.name).Export ModuleFile
                                  'ThisWorkbook.VBProject.VBComponents(Module).Export ModuleFile
                                  'MsgBox (ModuleFile)
                              '   Replace Module1 in Userbook
                                  Set VBP = Workbooks(Filename).VBProject
                                  'On Error Resume Next
                                  With VBP.VBComponents
                                      .Import ModuleFile
                                  End With
                              '   Delete the temporary module file
                                  Kill ModuleFile
                              End If
                          End If
                      Next
                  'book.Close True
              End If
      'Next
      
      
          End If
          If return_user_input = 7 Then
              MsgBox (wbfile.name & " no")
          End If
      
      
      
      
      
      Next
      
      Exit Sub
      ErrHandle:
      '   Did an error occur?
          MsgBox "ERROR. The module may not have been replaced.", _
            vbCritical
      
      
      End Sub
      Private Function FileNameOnly(pname) As String
          Dim temp As Variant
          Length = Len(pname)
          temp = Split(pname, Application.PathSeparator)
          FileNameOnly = temp(UBound(temp))
      End Function
      Sub basic_messagebox(wbfile, return_user_input)
          'source: http://www.databison.com/vba-message-box-msgbox-the-message-can-do-better/
          'vbOK = 1
          'vbCancel = 2
          'vbAbort = 3
          'vbRetry = 4
          'vbIgnore = 5
          'vbYes = 6
          'vbNo = 7
      
          i = MsgBox("Do you wish to force the new code on the following excel file: " & vbNewLine & vbNewLine & wbfile.name, vbYesNo)
          If i = 6 Then
              'MsgBox (wbFile.name & " yes")
              return_user_input = i
          End If
          If i = 7 Then
              'MsgBox (wbFile.name & " no")
              return_user_input = i
          End If
      
      End Sub
      
      1. MODULEX:
      2. 。(如果我删除这个点,格式化为listmode,代码将不再是4个空格后的代码,如果有人可以解释如何在列表中粘贴大的代码块,你可以让我开心)

        Sub DeleteAllCode(wbfile)
             'Source: http://www.vbaexpress.com/kb/getarticle.php?kb_id=93
             'Trust Access To Visual Basics Project must be enabled.
             'From Excel: Tools | Macro | Security | Trusted Sources
        
            Dim x               As Integer
            Dim Proceed         As VbMsgBoxResult
            Dim Prompt          As String
            Dim Title           As String
        
            Prompt = "Are you certain that you want to delete all the VBA Code from " & _
            ActiveWorkbook.name & "?"
            Title = "Verify Procedure"
        
            Proceed = MsgBox(Prompt, vbYesNo + vbQuestion, Title)
            If Proceed = vbNo Then
                MsgBox "Procedure Canceled", vbInformation, "Procedure Aborted"
                Exit Sub
            End If
        
            On Error Resume Next
            With ActiveWorkbook.VBProject
                For x = .VBComponents.count To 1 Step -1
                    .VBComponents.Remove .VBComponents(x)
                Next x
                For x = .VBComponents.count To 1 Step -1
                    .VBComponents(x).CodeModule.DeleteLines _
                    1, .VBComponents(x).CodeModule.CountOfLines
                Next x
            End With
            On Error GoTo 0
        
        End Sub