Entsperren mit Unprotect den Fehler abfangen
23.08.2025 21:12:17
wolfgang
Guten Abend alte Dresdner,
vielleicht hast Du ein Beispiel.
Ich sende mal mein Makro, welches überall gleich aber in der neuen Rechnung
verändert und in der Datenbank ebenso hinterlegt ist.
Ich hatte vorhin mal gesucht und dies gefunden:
Public Const STANDARD_PASSWORT As String = "war"
Public Function GetPasswort() As String
On Error Resume Next
GetPasswort = ThisWorkbook.Names("AktuellesPasswort").RefersToRange.Value
If Err.Number > 0 Or GetPasswort = "" Then
GetPasswort = STANDARD_PASSWORT
End If
On Error GoTo 0
End Function
Aber nichts verstanden.
Das ist mein Kopier-Makro:
Public Sub In_Rechnungs_Datenbank_kopieren()
Dim wksQ As Worksheet 'Quell-Worksheet
Dim wksZ As Worksheet 'Ziel-Worksheet
Dim wkbZ As Workbook, wkbQ As Workbook
Dim rngZIEL As Range
'Dim strSUCH As String
Const cstr_wkbQ = "Rg_Datenbank.xlsm"
Const cstr_wksQ = "Adressen"
Const pw = "tt"
Dim ze As Long, RDat As Date, RNr As String, lboOK As Boolean
Set wkbQ = ThisWorkbook
Set wksQ = ActiveSheet
Application.ScreenUpdating = False
On Error Resume Next
Set wkbZ = Workbooks(cstr_wkbQ)
On Error GoTo 0
If wkbZ Is Nothing Then
Set wkbZ = Workbooks.Open("D:\" & cstr_wkbQ)
End If
Set wksZ = wkbZ.Worksheets(cstr_wksQ)
With wksQ 'ActiveSheet
RDat = .Range("H29").value
RNr = .Range("H24").value ' & " - " & Format(.Range("J23").value, "0000")
End With
wkbZ.Activate
With Sheets("Adressen") ' wkbZ.("Adressen")
For ze = 3 To .Cells(.Rows.Count, 14).End(xlUp).Row ' 9 ist Datum gleich i
' If .Range("N" & ze).value = RDat Then
If InStr(.Range("O" & ze).value, RNr) > 0 Then ' J = Rechnungsnummer nach Ablauf
lboOK = True
Exit For
'End If
End If
Next ze
If lboOK Then
MsgBox "Vorhandener Datensatz wurde aktualisiert !"
Else
MsgBox "Datensatz wurde hinzugefügt !"
End If
wksZ.Unprotect "tt" ' bleibt immer hier stehen, da natürlich neues Passwort für die neue Datenbank benötigt wird
wksQ.Range("O11:O24").Copy 'Datensatz
.Cells(ze, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
'----- hier Rechnungs-Korrektur in Zelle LAND -----
If wksQ.Range("P34") = "_Rg.-Korrektur - " Then
.Cells(ze, 12) = "_Rg.-Korrektur - "
Else
wksQ.Range("O22").Copy 'sonst kopiere Land
.Cells(ze, 12).PasteSpecial Paste:=xlPasteValues
End If
'---------------------------------------------------
wksQ.Range("E371").Copy ' Rechnungsbetrag Netto
.Cells(ze, 13).PasteSpecial Paste:=xlPasteValues
wksQ.Range("H29").Copy 'DATUM
.Cells(ze, 14).PasteSpecial Paste:=xlPasteValues
wksQ.Range("H24").Copy 'Rg Nr.
.Cells(ze, 15) = RNr
wksQ.Range("P31").Copy 'FIRMA
.Cells(ze, 16).PasteSpecial Paste:=xlPasteValues
wksQ.Range("e23").Copy 'USER
.Cells(ze, 17).PasteSpecial Paste:=xlPasteValues
wksQ.Range("i1").Copy 'eRechnung
.Cells(ze, 18).PasteSpecial Paste:=xlPasteValues
wksZ.Protect DrawingObjects:=True, Password:="tt"
Application.CutCopyMode = False
wkbQ.Activate 'Datei
wksQ.Activate 'Sheet
Range("O12").Select
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = False
wkbZ.Close SaveChanges:=True
End Sub
ich hoffe Du hast mein Problem verstanden für dein Beispiel,
danke im Voraus
gruß wolfgang