Nochmal Module Tauschen
18.08.2003 18:05:52
Martin Salbeck
Kann mir jemand helfen!
Suche ein Makro das Module löscht
und mit einem neuen Modul vesehen werden soll.
Die Makros sind mit Passwort gesichert,die prozedur
soll ablaufen ohne eine Sicherheitsabfrage zu stellen!
Dabei handelt es sich nur um Module (Bas Dateien) die einen
festen Namen Haben und die mit einem Modul ebenfalls
fester Name ersetzt werden sollen, diese wiederum aus einem festen
Verzeichnis kommen!
Nepumuk war so freundlich mir dieses Makro zu schreiben!
Option Explicit
Public
Sub Export_Import()
Dim vbc As Object, iCounter As Integer, cType As String, StDateiname As String
Workbooks.Open "D:\Eigene Dateien\Eigene Tabellen\Exportmappe.xls"
SendKeys "%{F11} %Xi{TAB 9}" & "Dein Kennwort" & "{tab}{enter}{enter} %q"
For Each vbc In Workbooks("Exportmappe.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("Exportmappe.xls").VBProject.VBComponents(vbc.Name).Export "C:\Temp\" & vbc.Name & cType
Exit For
End If
Next iCounter
End With
Next vbc
Workbooks.Open "D:\Eigene Dateien\Eigene Tabellen\Testmappe.xls"
SendKeys "%{F11} %Xi{TAB 9}" & "Dein Kennwort" & "{tab}{enter}{enter} %q"
With Workbooks("Testmappe.xls").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:\temp\" & "*.*")
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:\Temp\" & 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
End Sub
Leider bleibt das Makro in der Zeile nach dem Passwort stehen,
Aussage ist:
Der Programmatische zugriff auf Visual Basic-Projekt ist nicht sicher!
Wer Kann mir weiter helfen
Danke im Voraus Martin