Run-Macro-in-protected-Project

Hi zusammen!
Ich habe vor einem Jahr eine Makro-Vorlage gebaut, mit denen Projekte kalkuliert werden.
Nennen wir Sie Vorlage B.
D.h., es liegen mittlerweile über 100 verschiedene Projekte vor, die alle im Format der Vorlage B vorliegen.
Also B1, B2 usw.
Die Vorlage B hat ca. 32 Tabellenblätter, von denen ich für mein neues Tool (siehe folgend) nur die Abschlusstabelle 15 benötige.
Die Vorlage B ist so aufgebaut, dass beim Öffnen der Datei nur das Tabellenblatt 1 angezeigt wird. Den Rest lässt man sich spezifisch einblenden.
Nun baue ich eine neue Datei, die eine Analyse dieser Projekte vornehmen soll.
Nennen wir Sie Vorlage A.
Dazu versuche ich, alle Projekte mit Vorlage B, die ich gerne untersuchen möchte, in einen Ordner zu werfen, und dass diese dann von meiner neuen Vorlage A durchgegangen werden.
Problem:
Um die o.g. Abschlusstabelle 15 anzuzeigen, muss ich also erst die Datei mit open-workbooks öffnen lassen und dann das in der Vorlage vorliegende Modul "alle_einblenden" ausführen (run).
Dies funktioniert leider nicht, weil das VBA-Projekt passwortgeschützt ist.
Wie kriege ich es hin, dass er, nachdem er mit open-workbooks die Datei geöffnet hat, die VBA-Umgebung mit dem vorliegenden Passwort ("Test") aktiviert, sodass ich dann mit Application.Run das benötigte "Sub" ausführen kann?
Ich dachte, ich hätte eine Lösung für die Passworteingabe gefunden (siehe im Code in fett und kursiv), aber das funktioniert nicht.


Sub Bereich_importieren()
Dim directory As String
Dim fileName As String
Dim sheet As Worksheet
Dim total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "C:\meinpfad\Test\"
fileName = Dir(directory & "*.xl?")
Do While fileName  ""
Workbooks.Open (directory & fileName)
ActiveWorkbook.Activate
Application.Run fileName & "!alle_einblenden", Password:="Test"
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("Gesamtdatei").Worksheets.Count
Workbooks(fileName).Worksheets("Name der Tabelle15").Copy _
after:=Workbooks("Gesamtdatei").Worksheets(total)
Next sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Vielen lieben Dank im Voraus fürs Lesen. Ich habe versucht, sehr genau zu sein, aber wenn noch Informationen benötigt werden, liefere ich die gerne nach :-)
Beste Grüße
Hendrik

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub alle_einblenden() Application.ScreenUpdating = False If Application.InputBox("Bitte geben Sie das Passwort ein!", "Passwortabfrage") = "Test" Then For Each ws In ThisWorkbook.Worksheets ws.Visible = xlSheetVisible Next ws Else MsgBox "Falsches Passwort", vbCritical, "Fehler" End If Application.ScreenUpdating = True End Sub

Option Explicit Sub Bereich_importieren() Const directory As String = "C:\meinpfad\Test\" Dim fileName As String Dim sheet As Worksheet Dim objWorkbook As Workbook Dim total As Integer With Application .ScreenUpdating = False .DisplayAlerts = False End With fileName = Dir$(directory & "*.xls*") Do Until fileName = "" Set objWorkbook = Workbooks.Open(directory & fileName) For Each sheet In objWorkbook.Worksheets sheet.Visible = xlSheetVisible total = Workbooks("Gesamtdatei").Worksheets.Count objWorkbook.Worksheets("Name der Tabelle15").Copy _ After:=Workbooks("Gesamtdatei").Worksheets(total) Next sheet objWorkbook.Close SaveChanges:=False fileName = Dir$ Loop Set objWorkbook = Nothing With Application .ScreenUpdating = True .DisplayAlerts = True End With End Sub

Sub Bereich_importieren() Const directory As String = "C:\meinpfad\Test\" Dim fileName As String Dim sheet As Worksheet Dim objWorkbook As Workbook Dim total As Integer With Application .ScreenUpdating = False .DisplayAlerts = False End With fileName = Dir$(directory & "*.xls*") Do Until fileName = "" Set objWorkbook = Workbooks.Open(directory & fileName) For Each sheet In objWorkbook.Worksheets sheet.Visible = xlSheetVisible 'Stelle1 Next sheet total = Workbooks("Gesamtdatei").Worksheets.Count 'Stelle2 objWorkbook.Worksheets("Name der Tabelle15").Copy _ After:=Workbooks("Gesamtdatei").Worksheets(total) objWorkbook.Close SaveChanges:=False fileName = Dir$ Loop Set objWorkbook = Nothing With Application .ScreenUpdating = True .DisplayAlerts = True End With End Sub

Option Explicit Public Sub Bereich_importieren() Const FOLDER_PATH As String = "C:\meinpfad\Test\" Dim strFileName As String Dim objWorksheet As Worksheet Dim objWorkbook As Workbook Application.ScreenUpdating = False strFileName = Dir$(FOLDER_PATH & "*.xls*") Do Until strFileName = "" Set objWorkbook = Workbooks.Open(FOLDER_PATH & strFileName) Set objWorksheet = Workbooks("Gesamtdatei").Worksheets.Add( _ After:=Worksheets(Workbooks("Gesamtdatei").Worksheets.Count)) Call objWorkbook.Worksheets("Name der Tabelle15").Cells.Copy( _ Destination:=objWorksheet.Cells(1, 1)) Call objWorkbook.Close(SaveChanges:=False) strFileName = Dir$ Loop Set objWorkbook = Nothing Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Run-Macro-in-protected-Project

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread