1 
Set wb = Workbooks(Filename)
Set codeModule = wb.VBProject.VBComponents("ThisWorkbook").codeModule
codeModule.InsertLines 3, "Hej jag kan spara detta"
wb.Save

以下は私の機能です。vbaproject のロックを解除して、ThisWorkbook に書き込みたいです。上記の4行(**のところ)を組み込むとなぜかワークブックのロックが解除されず、ThisWorkbookに「Hej jag kan spara detta」という行が適用されません。ただし、これらの 4 つの行がないと、ブックのロックが解除されます。また、コードを実行する前にワークブックのロックが解除されている場合、同じ 4 行も機能します。なにが問題ですか？

Sub merniplusplus()
    Dim path As String
    Dim Filename As Variant
    Dim wb As Workbook
    Dim CodeModule As Variant

    path = "C:\Merni\"

    Filename = Dir(path & "*.xls")
    Do While Filename <> ""
        If Filename <> "merni.xlsm" Then
            UnprotectPassword Workbooks(Filename), "2lbypo"

            Set wb = ActiveWorkbook
            Set CodeModule = wb.VBProject.VBComponents("ThisWorkbook").CodeModule
            CodeModule.InsertLines 3, "Hej jag kan spara detta"
            wb.Save
        End If
        Filename = Dir()
    Loop
End Sub

Sub UnprotectPassword(wb As Workbook, ByVal projectPassword As String)
    Dim currentActiveWb As Workbook

    If wb.VBProject.Protection <> 1 Then
        Exit Sub
    End If

    wb.Unprotect "poWorkbook"

    Set currentActiveWb = ActiveWorkbook
    wb.Activate

    SendKeys "%{F11}"
    SendKeys "^r" ' Set focus to Explorer
    SendKeys "{TAB}" ' Tab to locked project
    SendKeys "~" ' Enter
    SendKeys projectPassword
    SendKeys "~" ' Enter

    If (wb.VBProject.Protection = vbext_pp_locked) Then
        MsgBox ("failed to unlock")
    End If

    currentActiveWb.Activate
End Sub
4

1 に答える 1

1

二つのこと

  1. Filename = Dir()これらの 4 行の前ではなく、ループの前にある必要があります。それ以外の場合は、別のものを取得しますFilename。

  2. また、4行はIf Filename <> "merni.xlsm" Then 条件内にある必要があります

また、新しいワークブックを開く前にワークブックを閉じることもできます。そうしないと、多くのワークブックが開かれます:)

ファローアップ

ワークブックを開いているのではなく、毎回現在のワークブックに設定しているため、機能していません。以下のコードをテストしましたが、問題なく動作します。

Sub merniplusplus()
    Dim path As String, Filename As String
    Dim wb As Workbook
    Dim CodeModule As Variant

    path = "C:\Merni\"

    Filename = Dir(path & "*.xls")

    Do While Filename <> ""
        If Filename <> "merni.xlsm" Then
            Set wb = Workbooks.Open(path & Filename)

            UnprotectPassword wb, "2lbypo"

            Set CodeModule = wb.VBProject.VBComponents("ThisWorkbook").CodeModule
            CodeModule.InsertLines 3, "Hej jag kan spara detta"
            wb.Close SaveChanges:=True
        End If
        Filename = Dir
    Loop
End Sub
于 2012-07-03T12:58:46.143 に答える