Question

我创建了一个vba代码，它创建了一个新的.xlms文件，为该文件添加了一些代码然后我的问题是我无法保护该新文件的VBPoject。相反，我错误地密码保护当前的VBProject（不是新的，我想要的）。这是我的代码：

Sub Create_xlsm_File()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Dim ModuleName As String
Dim NewProcAsString As String
Dim myDir1 As String
Dim FileName1 As String
Dim FolderPath1 As String
Dim FilePath1 As String
Dim Pass1 As String
Dim SheetName1FileName1 As String
Dim MasterName As String
Dim NoOfSheets As Integer
Dim Newbook1 As Workbook

MasterName = Environ("UserName")
myDir1 = "C:\Users\" & MasterName & "\Desktop"
FileName1 = "LockedVBAProject"
Pass1 = "123"
NoOfSheets = 1
SheetName1FileName1 = "Sh1"
ModuleName = "Module1"
'----Creating and Save File-------------------------------------------
Set Newbook1 = Workbooks.Add
Newbook1.Activate
FilePath1 = myDir1 & "\" & FileName1
Application.SheetsInNewWorkbook = NoOfSheets
ActiveWorkbook.Sheets(1).Name = SheetName1FileName1
Newbook1.SaveAs Filename:=FilePath1, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:=Pass1
Workbooks(FileName1).Close False
'----Add the VBA code to the File-------------------------------------
Application.Workbooks.Open (FilePath1), Password:=Pass1
Workbooks(FileName1).Activate
'=====================================================================
'This part is the problem. the SendKeys applied to current project and
' not to the desired "LockedVBAProject"
'=====================================================================
With Application
      '//execute the controls to lock the project\\
      .VBE.CommandBars("Menu Bar").Controls("Tools") _
                  .Controls("VBAProject Properties...").Execute

      '//activate 'protection'\\
      .SendKeys "^{TAB}", True

      '//CAUTION: this either checks OR UNchecks the\\
      '//"Lock Project for Viewing" checkbox, if it's already\\
      '//been locked for viewing, then this will UNlock it\\
      .SendKeys "{ }", True

      '//enter password (password is 123 in this example)\\
      .SendKeys "{TAB}" & "123", True

      '//confirm password\\
      .SendKeys "{TAB}" & "123", True

      '//scroll down to OK key\\
      .SendKeys "{TAB}", True

      '//click OK key\\
      .SendKeys "{ENTER}", True

      'the project is now locked - this takes effect
      'the very next time the book's opened...
End With
'=====================================================================
'=====================================================================
'=====================================================================

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = ModuleName
Set VBComp = VBProj.VBComponents("ThisWorkbook")
Set CodeMod = VBComp.CodeModule

With CodeMod
    LineNum = .CreateEventProc("Open", "Workbook")
    LineNum = LineNum + 2
    NewProcAsString = "MsgBox ""Hola !!!"""
    CodeMod.InsertLines LineNum, NewProcAsString
End With

Workbooks(FileName1).Save
Workbooks(FileName1).Close False


ThisWorkbook.Activate

End Sub

您能帮我选择并密码保护所需的新“LockedVBAProject”文件吗？还有其他建议吗？提前感谢您的时间。

EXCEL VBA：如何将密码设置为另一个VBProject programmaticaly

0 个答案: