Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1548to1552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Falsch ?

Makro Falsch ?
27.03.2017 13:23:18
walter
Hallo zusammen,
ich möchte ein Makro in "Diese Arbeitsmappe" setzen,
damit die Datei nachher, beim wiederöffnen geschützt ist.
VB_Schreiben klappt, das andere nicht.
richtig eingesetzt, das andere nicht.
'Call VB_schreiben
'Call VB_Makro_Schutz_einfügen
Public Sub VB_schreiben()
Dim StrMakroText
StrMakroText = _
"

Public Sub Workbook_Open()" & Chr(10) & _
"  Call VB_Schutz" & Chr(10) & _
"End Sub
"
ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule.AddFromString StrMakroText
End Sub
Public Sub VB_Makro_Schutz_einfügen()
StrMakroText = _
"

Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = Application.Workbooks(akw)" & Chr(10) & _
Password = ww & Chr(10) & _
"SendKeys %{F11}^r{Tab}, True" & Chr(10) & _
"Do While Application.VBE.ActiveVBProject.Filename  wb.Fullname" & Chr(10) & _
"SendKeys {Tab}, True" & Chr(10) & _
"If wb.VBProject.Protection = vbext_pp_none Then" & Chr(10) & _
"SendKeys & %xi" & Chr(10) & _
"SendKeys & {TAB 9}" & Chr(10) & _
"SendKeys & {RIGHT}" & Chr(10) & _
"SendKeys & {TAB} & Chr(10) & _
"SendKeys & " "" & Chr(10) & _
"SendKeys & {TAB}" & Chr(10) & _
"SendKeys & Password" & Chr(10) & _
"SendKeys & {TAB}" & Chr(10) & _
"SendKeys & Password" & Chr(10) & _
"SendKeys & {TAB}" & Chr(10) & _
"SendKeys & {Enter}" & Chr(10) & _
"SendKeys & %{F11}, True" & Chr(10) & _
"End If" & Chr(10) & _
"End Sub
"
ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule.AddFromString StrMakroText
End Sub
mfg
walter mb

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Falsch ?
27.03.2017 14:04:03
ChrisL
Hi Walter
Keine Ahnung wozu so etwas gut ist, aber du hast die Anführungszeichen durcheinander gebracht.
Beispiele:
String = "Text"
String = "Text" & " noch mehr Text"
String = "Beispiel für ""Anführungszeichen"" innerhalb von einem Textstring"

Public Sub VB_Makro_Schutz_einfügen()
Dim StrMakroText As String
StrMakroText = _
"Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = Application.Workbooks(akw)" & Chr(10) & _
"Password = ww" & Chr(10) & _
"SendKeys ""%{F11}^r{Tab}"", True" & Chr(10) & _
"Do While Application.VBE.ActiveVBProject.Filename  wb.Fullname" & Chr(10) & _
"SendKeys ""{Tab}"", True" & Chr(10) & _
"If wb.VBProject.Protection = vbext_pp_none Then" & Chr(10) & _
"SendKeys ""%xi""" & Chr(10) & _
"SendKeys ""{TAB 9}""" & Chr(10) & _
"SendKeys ""{RIGHT}""" & Chr(10) & _
"SendKeys ""{TAB}""" & Chr(10) & _
"SendKeys "" """ & Chr(10) & _
"SendKeys ""{TAB}""" & Chr(10) & _
"SendKeys ""Password""" & Chr(10) & _
"SendKeys ""{TAB}""" & Chr(10) & _
"SendKeys ""Password""" & Chr(10) & _
"SendKeys ""{TAB}""" & Chr(10) & _
"SendKeys ""{Enter}""" & Chr(10) & _
"SendKeys ""%{F11}"", True" & Chr(10) & _
"End If" & Chr(10) & _
"End Sub"
ActiveWorkbook.VBProject.VBComponents("DieseArbeitsmappe").CodeModule.AddFromString  _
StrMakroText
End Sub

cu
Chris
Anzeige
Hallo Chris werde...
27.03.2017 15:10:14
walter
Hallo Chris,
versuche mal umzusetzen.
Das Makro soll in die "Diese Arbeitsmappe" erstellt werden.
Beim nächsten öffnen der Datei ist der Schutz dann aktiv.
mfg
walter mb
Danke für die Rückmeldung owT
27.03.2017 15:29:36
ChrisL
geschlossen
AW: Hallo Chris werde...
27.03.2017 16:51:09
Luschi
Hallo Walter,
M$ läßt sich in jeder neuen Excel Version was Anderes einfallen, um das Setzen/Aufheben des Vba- _ Kennwortes per Vba zu erschweren. Seit Excel 2013 läuft diese Schleife nicht mehr:

Do While Application.VBE.ActiveVBProject.Filename  wb.FullName
SendKeys "{Tab}", True
Loop
Sie wird vom Interpreter einfach verschluckt
Der SendKeys-Befehl darf nicht mehr in Teil-Befehle zerstückelt werden, sondern muß alle Schritte in einem enthalten.
Der eigentlich überflüssige Stop-Befehl sorgt aber dafür. das das aktuelle Vba-Projekt, in dem das Makro steht, aktiv ist - ohne dem wird bei mir in Excel 2013/16 ein geschütztes Vba-Projekt aktiviert und die ganze Sache war umsonst.
So sieht mein aktuelles Makro zum Setzen des Vba-Kennwortes aus:

Public Sub VB_Schutz()
Dim Password As String
Dim vbext_pp_none
Dim wb As Workbook, ok As Boolean, s As String
Set wb = ThisWorkbook   'Application.Workbooks(akw)
Password = "ww::pp**qq"
SendKeys "%{F11}^r{Tab}", True
'Do While Application.VBE.ActiveVBProject.Filename  wb.FullName
'    Debug.Print "***" & " - " & Application.VBE.ActiveVBProject.Filename
'    SendKeys "{Tab}", True
'Loop
Debug.Print ":::" & " - " & Application.VBE.ActiveVBProject.Filename
'If wb.VBProject.Protection = vbext_pp_none Then
'Dieser Stop-Befehl ist erforderlich, damit der Focus im Vba-Editor auch auf dam
'richtigen Projekt steht!!!
Stop 'hier hält der Debugger an und mit 'Fortsetzen' weiter
If wb.VBProject.Protection = 0 Then
'nur ein einziger SendKeys-Befehl
SendKeys "%xi{TAB 9}{RIGHT}{TAB} {TAB}" & Password & "{TAB}" & _
Password & "{TAB}{Enter}%{F11}", False   'True
End If
Set wb = Nothing
End Sub
Gruß von Luschi
aus klein-Paris
Anzeige
Perfekt aber...
27.03.2017 17:14:54
walter
Hallo Luschi,
soweit getestet, perfekt !
Aber ich möchte das ja bei einer neu erstellten Datei in die
"DieseArbeitsmappe" reinschreiben, so das beim nächsten öffnen
die Datei geschützt ist.
Komme mit der Umsetzung nicht weiter, bitte um HILFE,
danke im Voraus.
mfg
walter mb
Luschi bitte mal schauen
27.03.2017 17:28:59
walter
Hallo,
Public Sub NEU_VB_Makro_Schutz_einfügen()
StrMakroText = _
"

Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Password = " & """ww""" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = ThisWorkbook" & Chr(10) & _
"Password = " & "wbns" & Chr(10) & _
"SendKeys " & """%{F11}^r{Tab}, True""" & Chr(10) & _
>hier bleibt stehen       "Debug.Print "":::" & " - " & "Application.VBE.ActiveVBProject. _
Filename"" & Chr(10) & _
"If wb.VBProject.Protection =" & "0 Then" & Chr(10) & _
"SendKeys" "%xi{TAB 9}{RIGHT}{TAB} {TAB}" & Password & "{TAB}" & _
"Password & "{TAB}{Enter}%{F11}", False"   'True
End If
Set wb = Nothing
End Sub

gruß
walter mb
Anzeige
Luschi bitte mal schauen
27.03.2017 17:29:00
walter
Hallo,
Public Sub NEU_VB_Makro_Schutz_einfügen()
StrMakroText = _
"

Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Password = " & """ww""" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = ThisWorkbook" & Chr(10) & _
"Password = " & "wbns" & Chr(10) & _
"SendKeys " & """%{F11}^r{Tab}, True""" & Chr(10) & _
>hier bleibt stehen       "Debug.Print "":::" & " - " & "Application.VBE.ActiveVBProject. _
Filename"" & Chr(10) & _
"If wb.VBProject.Protection =" & "0 Then" & Chr(10) & _
"SendKeys" "%xi{TAB 9}{RIGHT}{TAB} {TAB}" & Password & "{TAB}" & _
"Password & "{TAB}{Enter}%{F11}", False"   'True
End If
Set wb = Nothing
End Sub

gruß
walter mb
Anzeige
Luschi bitte mal schauen
27.03.2017 17:29:01
walter
Hallo,
Public Sub NEU_VB_Makro_Schutz_einfügen()
StrMakroText = _
"

Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Password = " & """ww""" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = ThisWorkbook" & Chr(10) & _
"Password = " & "wbns" & Chr(10) & _
"SendKeys " & """%{F11}^r{Tab}, True""" & Chr(10) & _
>hier bleibt stehen       "Debug.Print "":::" & " - " & "Application.VBE.ActiveVBProject. _
Filename"" & Chr(10) & _
"If wb.VBProject.Protection =" & "0 Then" & Chr(10) & _
"SendKeys" "%xi{TAB 9}{RIGHT}{TAB} {TAB}" & Password & "{TAB}" & _
"Password & "{TAB}{Enter}%{F11}", False"   'True
End If
Set wb = Nothing
End Sub

gruß
walter mb
Anzeige
Luschi bitte mal schauen
27.03.2017 17:29:02
walter
Hallo,
Public Sub NEU_VB_Makro_Schutz_einfügen()
StrMakroText = _
"

Public Sub VB_Schutz()" & Chr(10) & _
"Dim Password As String" & Chr(10) & _
"Password = " & """ww""" & Chr(10) & _
"Dim vbext_pp_none" & Chr(10) & _
"Dim wb As Workbook, ok As Boolean, s As String" & Chr(10) & _
"Set wb = ThisWorkbook" & Chr(10) & _
"Password = " & "wbns" & Chr(10) & _
"SendKeys " & """%{F11}^r{Tab}, True""" & Chr(10) & _
>hier bleibt stehen       "Debug.Print "":::" & " - " & "Application.VBE.ActiveVBProject. _
Filename"" & Chr(10) & _
"If wb.VBProject.Protection =" & "0 Then" & Chr(10) & _
"SendKeys" "%xi{TAB 9}{RIGHT}{TAB} {TAB}" & Password & "{TAB}" & _
"Password & "{TAB}{Enter}%{F11}", False"   'True
End If
Set wb = Nothing
End Sub

gruß
walter mb
Anzeige
Perfekt aber...
27.03.2017 17:28:00
walter
Hallo Luschi,
soweit getestet, perfekt !
Aber ich möchte das ja bei einer neu erstellten Datei in die
"DieseArbeitsmappe" reinschreiben, so das beim nächsten öffnen
die Datei geschützt ist.
Komme mit der Umsetzung nicht weiter, bitte um HILFE,
danke im Voraus.
mfg
walter mb
AW: Perfekt aber...
27.03.2017 17:32:51
Luschi
Hallo Walter,
schaue ich mir an - ist die neu erstellte Datei schon gespeichert?
Gruß von Luschi
aus klein-Paris
Ja soweit aber
27.03.2017 18:04:16
walter
Würde auch ggf. ein Modul in die neu erstellte Datei
kopieren, hatte das mal gefunden:
Dim Pfad As String
Pfad = ThisWorkbook.Path & "\Modul1.bas"
'Modul1 aus dieser Mappe exportieren
'Application.VBE.ActiveVBProject.VBComponents("Modul2").Export Pfad
Workbooks.WBName
'Modul1 in neue Mappe importieren
With ActiveWorkbook
Application.VBE.ActiveVBProject.VBComponents.Import Pfad
End With
gruß
walter mb
'Kopie von Modul1 löschen
''Kill Pfad
MsgBox "Modul in neue Mappe kopiert", , ""
'-------------------------------------------------------------------
Anzeige
Hallo Luschi, darf...
28.03.2017 17:30:35
Walter
Hallo Luschi,
Darf ich noch mit deiner Unterstützung rechnen ?
Würde mich freuen, ich bastel jetzt schon über 8h und bekomme es
nicht hin.
Mit freundlichen Grüßen
Walter mb
Bitte dringend... danke im Voraus
28.03.2017 19:43:38
walter
Guten Abend,
ich werd nochmal verrückt,
hier bleibt Makro stehen:
Stop 'hier hält der Debugger an und mit 'Fortsetzen' weiter
wenn ich ins Makro gehe, ist diese Zeile gelb.
Wie kann man dies bewerkstelligen das es von selbst weiter geht ?
gruß
walter mb
AW: Bitte dringend... danke im Voraus
30.03.2017 12:36:37
Rudi
Hallo,
was heißt 'Stop' wohl?
Wenn du willst, dass es so weitergeht, lösche den Befehl.
Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige