Wer kann mir Helfen
20.08.2003 17:59:53
Martin Salbeck
Ich will per Makro aus einer datei ein bestimmtes Module
von mehreren löschen,
Dieses Module hat auch einen festen Namen,
danach will ich ein neues
Module aus einem Verzeichnis ebenfalls mit festen Namen importieren.
Das ganze soll ohne Sicherheitsabfrage passieren!
Das hier unten angegebene Makro Läuft nur wenn vorher in VBA
Eigenschaften, Schutz,
Projecktschutz für anzeige Sperren! herausgenomen wird!
Dieses soll aber auch per Makro laufen.
Passwort stimmt und in sicherheit vertrauenwürdige quellen ist auch
Aktiviert.
Wer Kann mir helfen
Danke im voraus Martin
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