Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
820to824
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
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Blattschutz in meinen VBA integrieren

Blattschutz in meinen VBA integrieren
22.11.2006 12:54:45
lisa
Hallo Excelfreunde
Ihr habt schon viel geholfen und deshalb wende ich mich auch noch mal an Euch
Ich möchte gerne den Zielbereich geschützt haben.
Dazu müßte,
ActiveSheet.Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
irgendwie in diesen Code geschrieben werden.
Ziel ist es, die Zieldatei außerhalb des beschreibens durch den Code Schreibgeschützt zu haben.
hat jemand Zeit für mich sich dessen anzunehmen?
Für die Hilfe schon mal herzlichen Dank im voraus
Gruß Lisa
Dim i As Integer
i = Sheets("Datenbank").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
If i &lt 4 Then i = 4
' ZIELBEREICH 'QUELLBEREICH
Sheets("Datenbank").Cells(i, 1) = Sheets("Dateneingabe").Cells(4, 2)
Sheets("Datenbank").Cells(i, 2) = Sheets("Dateneingabe").Cells(4, 3)
Sheets("Datenbank").Cells(i, 3) = Sheets("Dateneingabe").Cells(4, 4)
Sheets("Datenbank").Cells(i, 5) = Sheets("Dateneingabe").Cells(4, 5)
Sheets("Datenbank").Cells(i, 4) = Sheets("Dateneingabe").Cells(4, 6)
'Sheets("Datenbank").Cells(i, 6) = Sheets("Dateneingabe").Cells(4, 7)'
Sheets("Datenbank").Cells(i, 7) = Sheets("Dateneingabe").Cells(4, 8)
Sheets("Datenbank").Cells(i, 8) = Sheets("Dateneingabe").Cells(4, 9)
Sheets("Datenbank").Cells(i, 9) = Sheets("Dateneingabe").Cells(4, 10)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Dim wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim Zeile As Long
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Sheets("Dateneingabe")
Set wbZiel = Workbooks.Open(Filename:="W:\Daten\Einlagerung\Datenbank.xls")
Set wksZiel = wbZiel.Sheets("Datenbank")
With wksZiel
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blattschutz in meinen VBA integrieren
22.11.2006 16:01:57
fcs
Hallo Lisa,
ein wenig besser hättest du deinen Code aber schon auf Basis einer früheren Hilfstellung
vorbereiten können.
https://www.herber.de/forum/archiv/816to820/t818134.htm#818134
Hier geht ja noch alles durcheinander.
Ich hab jetzt zusätzlich eine Prüfung eingebaut ob die Zieldatei schon geöffnet ist.
Gruß
Franz

Sub Test()
Dim wbQuelle As Workbook, wbZiel As Workbook, wb As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim i As Long
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Sheets("Dateneingabe")
'Prüfung ob Datenbank.xls bereits geöffnet
For Each wb In Workbooks
If LCase(wb.Name) = LCase("Datenbank.xls") Then
If LCase(wb.Path) = LCase("W:\Daten\Einlagerung") Then
Set wbZiel = Workbooks("Datenbank.xls")
Exit For
Else
MsgBox "Verzeichnis der geöffneten 'Datenbank.xls' ist nicht 'W:\Daten\Einlagerung' " _
& vbLf & vbLf & "Bitte geöffnete Datenbank.xls erst schließen!"
Exit Sub
End If
End If
Next
If wbZiel Is Nothing Then
Set wbZiel = Workbooks.Open(Filename:="W:\Daten\Einlagerung\Datenbank.xls")
End If
Set wksZiel = wbZiel.Sheets("Datenbank")
With wksZiel
.Unprotect
i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If i < 4 Then i = 4
' ZIELBEREICH 'QUELLBEREICH
.Cells(i, 1) = wksQuelle.Cells(4, 2)
.Cells(i, 2) = wksQuelle.Cells(4, 3)
.Cells(i, 3) = wksQuelle.Cells(4, 4)
.Cells(i, 5) = wksQuelle.Cells(4, 5)
.Cells(i, 4) = wksQuelle.Cells(4, 6)
'.Cells(i, 6) = wksQuelle.Cells(4, 7)'
.Cells(i, 7) = wksQuelle.Cells(4, 8)
.Cells(i, 8) = wksQuelle.Cells(4, 9)
.Cells(i, 9) = wksQuelle.Cells(4, 10)
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
'  wbZiel.Close savechanges:=True 'diese Zeile ggf. aktivieren wenn Zieldatei _
nach jeder Eingabe wieder geschlossen werden soll
End Sub

Anzeige
AW: Blattschutz in meinen VBA integrieren
23.11.2006 10:44:50
Lisa
Moment bitte,
erst einmal schönen Dank für die Hilfe, aber das was du meinst, (schlechte Vorbereitung) ist nicht ganz so wie es scheint!
Ich habe da zwei Codes zu laufen. Der erste, den du mir geä. hast, der speichert extern.
Läuft so auch prima.
Der zweite, speichert in der gleichen Mappe in einer extra Tabelle, Namens "Datenbank"
Ich habe dir den falschen Code eingefügt. :-(
Nun wird die Tabelle aber ständig nach dem speichern manipuliert und deswegen sollte nur in diesem Teil die Tabelle "Datenbank" Passwort geschützt sein.
der Code öffnet die Tabellem muß per unprotect erst den Schutz rausnehmen, speichert und anschließend legt der Code, per protect wieder den Schutz auf die Tabelle.
Nur leider weiß ich nicht wie ich das in diesem Code schreiben soll.
ActiveSheet.Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
If Zeile &lt 4 Then Zeile = 4
' ZIELBEREICH " Datenbank"'QUELLBEREICH
.Cells(Zeile, 1) ~f~ = wksQuelle.Cells(4, 2)
~f~ .Cells(Zeile, 2) ~f~ = wksQuelle.Cells(4, 3)
~f~.Cells(Zeile, 3) ~f~ = wksQuelle.Cells(4, 4)
~f~ .Cells(Zeile, 5) ~f~ = wksQuelle.Cells(4, 5)
~f~ .Cells(Zeile, 4) ~f~= wksQuelle.Cells(4, 6)
~f~ '.Cells(Zeile, 6) ~f~ = wksQuelle.Cells(4, 7)'
~f~.Cells(Zeile, 7) ~f~= wksQuelle.Cells(4, 8)
~f~ .Cells(Zeile, 8) ~f~ = wksQuelle.Cells(4, 9)
~f~ .Cells(Zeile, 9) = wksQuelle.Cells(4, 10)
End With
wbZiel.Close savechanges:=True
danke
mfg Lisa
Anzeige
AW: Blattschutz in meinen VBA integrieren
23.11.2006 12:00:02
fcs
Hallo Lisa,
eigentlich ist der Code schon sehr ähnlich. Es gibt halt nur keine Ziel-Arbeitsmappe.
Das Passwort für Schutz Aus/Ein muss du direkt im Code mit verarbeiten. Deshalb auch im VBA-Editor das VBA-Projekt nach rechte Maus-Klick unter Eigenschaften VBA-Projekt mit Kennwort schützen, damit nicht jeder reinsehen kann.
Gruß
Franz

Sub Test()
Dim wbQuelle As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim i As Long
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Sheets("Dateneingabe")
Set wksZiel = wbQuelle.Sheets("Datenbank")
With wksZiel
.Unprotect Password:="SuperADMIN1"
i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If i < 4 Then i = 4
' ZIELBEREICH 'QUELLBEREICH
.Cells(i, 1) = wksQuelle.Cells(4, 2)
.Cells(i, 2) = wksQuelle.Cells(4, 3)
.Cells(i, 3) = wksQuelle.Cells(4, 4)
.Cells(i, 5) = wksQuelle.Cells(4, 5)
.Cells(i, 4) = wksQuelle.Cells(4, 6)
'.Cells(i, 6) = wksQuelle.Cells(4, 7)'
.Cells(i, 7) = wksQuelle.Cells(4, 8)
.Cells(i, 8) = wksQuelle.Cells(4, 9)
.Cells(i, 9) = wksQuelle.Cells(4, 10)
.Protect Password:="SuperADMIN1", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
wbZiel.Close savechanges:=True 'Ist diese Zeile hiernoch notwendig? eine Zielmappe gibt es ja nicht mehr.
'evtl. besser nach jeder Eingabe die Quell-Datei(=Aktive Datei) speichern
wbQuelle.Save
End Sub

Anzeige
AW: Blattschutz in meinen VBA integrieren
23.11.2006 12:55:59
Lisa
Hallo Franz
endschuldige ersteinmal das durcheinander und sei bitte nicht verärgert
Ich habe es ausprobiert aber es klappt nicht, da du wahrscheinlich nicht genau nachvollziehen kannst was ich mit dem gesamten Code bezwecken will.
Ich füge hier noc´h einmal den gesamten Code bei, vieleicht verstehst du es dann besser.
Denke aber bitte daran, das ich das als völliger Leie mache.
Es ist Zweckmäßig, auch wenn du das als Fachman vielleicht anders gemacht hättest.
Ich schreibe in den Code noch mal rein was ich bis dahin erreiche.
Ich hoffe sehr das du es nachvollziehen kannst.
Ps: Ich gebe mir Mühe, aber wenn man keine Ahnung hat von der Materie ist es Schwierig und ich kann noch nicht einmal die Finger davon lassen (es Spannend wenn man sieht was alles gemacht werden kann)
mfG Lisa

Sub DatenübernahmeTabelle() 'hier kopiere ich Daten in eine Tabelle die gedruckt wird'
Range("E4").Select
Selection.Copy
Range("B13:C17").Select
ActiveSheet.Paste
Dim wsT As Worksheet
Static n As Byte
If n < 4 Then n = 3
n = IIf(n >= 25, 4, n)
Set wsT = Worksheets("Dateneingabe")
With Worksheets("Druck")
wsT.Range("i4").Copy .Range("B4:k8")
wsT.Range("j4").Copy .Range("b11:k15")
wsT.Range("h4").Copy .Range("B18:k22")
wsT.Range("f4").Copy .Range("B25:k29")
wsT.Range("e4").Copy .Range("A32:k73")
.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
.Range("B4:k8").ClearContents
.Range("B11:k15").ClearContents
.Range("B18:k22").ClearContents
.Range("B25:k29").ClearContents
.Range("A32:k73").ClearContents ' hier lösche ich die Daten aus dem Druckblatt wieder'
End With
wsT.Activate ' hier nehme ich die Daten noch einmal um sie in die Datenbank zu speichern'
Dim i As Integer
i = Sheets("Datenbank").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
If i < 4 Then i = 4
' ZIELBEREICH                   'QUELLBEREICH
Sheets("Datenbank").Cells(i, 1) = Sheets("Dateneingabe").Cells(4, 2)
Sheets("Datenbank").Cells(i, 2) = Sheets("Dateneingabe").Cells(4, 3)
Sheets("Datenbank").Cells(i, 3) = Sheets("Dateneingabe").Cells(4, 4)
Sheets("Datenbank").Cells(i, 5) = Sheets("Dateneingabe").Cells(4, 5)
Sheets("Datenbank").Cells(i, 4) = Sheets("Dateneingabe").Cells(4, 6)
'Sheets("Datenbank").Cells(i, 6) = Sheets("Dateneingabe").Cells(4, 7)'
Sheets("Datenbank").Cells(i, 7) = Sheets("Dateneingabe").Cells(4, 8)
Sheets("Datenbank").Cells(i, 8) = Sheets("Dateneingabe").Cells(4, 9)
Sheets("Datenbank").Cells(i, 9) = Sheets("Dateneingabe").Cells(4, 10)
Dim wbQuelle As Workbook, wbZiel As Workbook ' hier nehem ich die Daten nocheinmal um sie zum 2. mal extern zu speichern'
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim Zeile As Long
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Sheets("Dateneingabe")
Set wbZiel = Workbooks.Open(Filename:="W:\\Einlagerung\Datenbank.xls")
Set wksZiel = wbZiel.Sheets("Datenbank")
With wksZiel
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If Zeile < 4 Then Zeile = 4
' ZIELBEREICH 'QUELLBEREICH
.Cells(Zeile, 1) = wksQuelle.Cells(4, 2)
.Cells(Zeile, 2) = wksQuelle.Cells(4, 3)
.Cells(Zeile, 3) = wksQuelle.Cells(4, 4)
.Cells(Zeile, 5) = wksQuelle.Cells(4, 5)
.Cells(Zeile, 4) = wksQuelle.Cells(4, 6)
'.Cells(Zeile, 6) = wksQuelle.Cells(4, 7)'
.Cells(Zeile, 7) = wksQuelle.Cells(4, 8)
.Cells(Zeile, 8) = wksQuelle.Cells(4, 9)
.Cells(Zeile, 9) = wksQuelle.Cells(4, 10)
End With
wbZiel.Close savechanges:=True
Range("e4:i4").Select ' hier lösche ich die Daten aus der Quellbereich'
Selection.ClearContents
Range("c4").Select
Selection.ClearContents
Range("c5").Select
End Sub

Anzeige
AW: Blattschutz in meinen VBA integrieren
23.11.2006 14:34:50
fcs
Hallo Lisa,
manchmal fehlt halt nur das kleine bischen an Informationen, um Mißverständnisse zu vermeiden.
Ich denke die Zeilen zum AUS-/EIN-Schalten des Blattschutzes für das Blatt "Datenbank" stehen jetzt an der richtigen Stelle.
Das Passwort SuperADMIN1 muss du im Code jeweils durch das von dir für das Blatt Datenbank verwendete Passwort ersetzen.
Gruß
Franz

Sub DatenübernahmeTabelle()
'Eingabedaten in Tabelle Druck kopieren ###
Range("E4").Select
Selection.Copy
Range("B13:C17").Select
ActiveSheet.Paste
Dim wsT As Worksheet
Static n As Byte
If n < 4 Then n = 3
n = IIf(n >= 25, 4, n)
Set wsT = Worksheets("Dateneingabe")
With Worksheets("Druck")
wsT.Range("i4").Copy .Range("B4:k8")
wsT.Range("j4").Copy .Range("b11:k15")
wsT.Range("h4").Copy .Range("B18:k22")
wsT.Range("f4").Copy .Range("B25:k29")
wsT.Range("e4").Copy .Range("A32:k73")
.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' Daten im Blatt Druck wieder löschen ####'
.Range("B4:k8").ClearContents
.Range("B11:k15").ClearContents
.Range("B18:k22").ClearContents
.Range("B25:k29").ClearContents
.Range("A32:k73").ClearContents
End With
' Eingabedaten im Blatt Datenbank speichern #####
wsT.Activate
Dim i As Integer
i = Sheets("Datenbank").Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
If i < 4 Then i = 4
'#### Blattschutz AUS ####
Sheets("Datenbank").Unprotect Password:="SuperADMIN1"
' ZIELBEREICH                   'QUELLBEREICH
Sheets("Datenbank").Cells(i, 1) = Sheets("Dateneingabe").Cells(4, 2)
Sheets("Datenbank").Cells(i, 2) = Sheets("Dateneingabe").Cells(4, 3)
Sheets("Datenbank").Cells(i, 3) = Sheets("Dateneingabe").Cells(4, 4)
Sheets("Datenbank").Cells(i, 5) = Sheets("Dateneingabe").Cells(4, 5)
Sheets("Datenbank").Cells(i, 4) = Sheets("Dateneingabe").Cells(4, 6)
'Sheets("Datenbank").Cells(i, 6) = Sheets("Dateneingabe").Cells(4, 7)'
Sheets("Datenbank").Cells(i, 7) = Sheets("Dateneingabe").Cells(4, 8)
Sheets("Datenbank").Cells(i, 8) = Sheets("Dateneingabe").Cells(4, 9)
Sheets("Datenbank").Cells(i, 9) = Sheets("Dateneingabe").Cells(4, 10)
'#### Blattschutz wieder EIN ####
Sheets("Datenbank").Protect Password:="SuperADMIN1", DrawingObjects:=True, Contents:=True, Scenarios:=True
' Eingabe-Daten in externer Datei speichern ####
Dim wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim Zeile As Long
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Sheets("Dateneingabe")
Set wbZiel = Workbooks.Open(Filename:="W:\\Einlagerung\Datenbank.xls")
Set wksZiel = wbZiel.Sheets("Datenbank")
With wksZiel
Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If Zeile < 4 Then Zeile = 4
' ZIELBEREICH 'QUELLBEREICH
.Cells(Zeile, 1) = wksQuelle.Cells(4, 2)
.Cells(Zeile, 2) = wksQuelle.Cells(4, 3)
.Cells(Zeile, 3) = wksQuelle.Cells(4, 4)
.Cells(Zeile, 5) = wksQuelle.Cells(4, 5)
.Cells(Zeile, 4) = wksQuelle.Cells(4, 6)
'.Cells(Zeile, 6) = wksQuelle.Cells(4, 7)'
.Cells(Zeile, 7) = wksQuelle.Cells(4, 8)
.Cells(Zeile, 8) = wksQuelle.Cells(4, 9)
.Cells(Zeile, 9) = wksQuelle.Cells(4, 10)
End With
wbZiel.Close savechanges:=True
' hier lösche ich die Eingabe-Daten aus dem Quellbereich'
Range("e4:i4").Select
Selection.ClearContents
Range("c4").Select
Selection.ClearContents
Range("c5").Select
End Sub

Anzeige
Danke für deine Gedult, es klappt tadellos! oT
23.11.2006 15:32:59
Lisa

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige