要在不同的PowerPoint文件之间传输VBA宏,我可以将模块导出为BAS文件,然后将其导入另一个文件。但这必须手动完成。
我的Java 1.8应用程序将使用Apache POI自动生成新的PowerPoint文件,然后调用VBScript。该脚本将通过命令行从Java应用程序接收参数,然后打开创建的PowerPoint文件并调用宏,最后将参数传递给宏。
在所有可能发生之前,我需要先将模板PowerPoint文件中的多个宏自动导入到新创建的文件中。如何使用Java或VBS进行此操作?
编辑:如果您因为过于宽泛而要关闭它,您至少可以告诉我它的具体程度如何吗?因为据我所知,我已经非常明确地说明了我想要实现的目标。这是我第一次使用VBA或VBS进行编码,因此我不知道我对此主题的期望是什么,特别是"。
答案 0 :(得分:0)
将所有模块从1个母本文件导出到另一个.xlsm文件:
接下来,创建两个模块,
。(如果我删除这个点,格式化为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
。(如果我删除这个点,格式化为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