SendKey Probleme beim Projektschutz!
12.08.2005 11:01:39
Martin
Das schnall ich nicht mehr.
Wenn ich das Makro "Entschützen1()" laufen lasse. wird die Tabelle Export.xls geöffnet und das Projekt entschützt.
Das funktioniert auch bestens.
Wenn jetzt aber das nächste Macro in der geplanten Reienfolge startet, wird der Projektschutz nicht entschützt.
Einzeln läufts, in einer Abfolge von Prozeduren nicht! Für mich nicht mehr nachvollziebar.
Option Explicit
Sub Import_Export()
Entschützen1
Export
Entschützen2
Import
End Sub
Public Sub Entschützen1()
Application.EnableEvents = False
Workbooks.Open "J:\AKTIONEN\Cockpit Aktionen\Save\In Arbeit\Export.xls"
Windows("Export.xls").Activate
ActiveSheet.Unprotect Password:="******"
ActiveWorkbook.Unprotect Password:="******"
Application.EnableEvents = True
SendKeys "%{F11} %Xi {TAB 9}" & "service" & "{tab}{enter}{enter} %q"
Application.EnableEvents = False
End Sub
Sub Export()
Dim vbc As Object, iCounter As Integer, cType As String, StDateiname As String
For Each vbc In Workbooks("Export.xls").VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Or InStr(1, .Lines(iCounter, 1), "Dim") <> 0 _
Or InStr(1, .Lines(iCounter, 1), "Public") <> 0 Or InStr(1, .Lines(iCounter, 1), "Type") <> 0 _
Or InStr(1, .Lines(iCounter, 1), "Static") <> 0 Or InStr(1, .Lines(iCounter, 1), "Declare") <> 0 Then
Select Case vbc.Type
Case 1: cType = ".bas"
Case 2, 100: cType = ".cls"
Case 3: cType = ".frm"
End Select
Workbooks("Export.xls").VBProject.VBComponents(vbc.Name).Export "C:\ModuleExportImport\" & vbc.Name & cType
Exit For
End If
Next iCounter
End With
Next vbc
End Sub
Sub Entschützen2()
Application.EnableEvents = False
Workbooks.Open "J:\AKTIONEN\Cockpit Aktionen\Save\In Arbeit\Import.xls"
Windows("Import.xls").Activate
ActiveSheet.Unprotect Password:="******"
ActiveWorkbook.Unprotect Password:="******"
Application.EnableEvents = True
SendKeys "%{F11} %Xi" & "service" & "{tab}{enter}{enter} %q"
Application.EnableEvents = False
End Sub
Sub Import()
Dim vbc As Object, iCounter As Integer, cType As String, StDateiname As String
Windows("Export.xls").Activate
Worksheets("Meldeblatt").Range("A1:IV65536").Copy
Windows("Import.xls").Activate
With Range("A1")
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
StDateiname = Dir("C:\ModuleExportImport\" & "*.*")
Do While StDateiname <> ""
If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" Or UCase(Right(StDateiname, 4)) = ".CLS" Then
.VBComponents.Import "C:\ModuleExportImport\" & StDateiname
End If
StDateiname = Dir
Loop
For Each vbc In .VBComponents
If vbc.Type = 2 Then
If Left(vbc.Name, 5) = "Diese" Or Left(vbc.Name, 7) = "Tabelle" Then
.VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1, vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
.VBComponents.Remove .VBComponents(vbc.Name)
End If
End If
Next vbc
End With
Application.EnableEvents = False
End Sub