Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1876to1880
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 umschreiben

Makro umschreiben
06.04.2022 09:37:50
MoneWa
Hallo,
ich bin neu hier und bräuchte mal Hilfe beim umschreiben eines Makros. Es wurde durch jemand anderen programmiert und ich hab leider keine Ahnung davon... kann es nicht richtig lesen/ändern. Aber ich denke für Euch ein Kinderspiel.
Es geht darum, dass in einer bestimmten Spalte (hier: AL = 38. Spalte) nur der User etwas schreiben kann, der in Zeile 3, Spalte AL mit Username vorgegeben wurde.
Aktuell läuft das Makro über mehrere Spalten hinweg (AL-AX = 38-50), sodass mehrere User vorgegeben werden können - aber ich brauche es eben nur für die eine Spalte.
Hier die aktuelle Programmierung:

' ab hier USERID lesen und Zellen sperren / entsperren für die Kommentierung
Sheets("Master").Select
Dim KeyCells As Range
Dim USERID As String
Dim C, A As Integer
Dim Spalte As Long
Dim USERID_CHECK, ADMINID_CHECK As String
USERID = Environ("Username") ' UserID auslesen und in Var speichern
ActiveSheet.Cells.ClearOutline
ActiveSheet.Columns("W:AI").Columns.Group
ActiveSheet.Columns("W:AI").Columns.Hidden = False
For C = 38 To 50 ' = Spalten 38-50 = AL-AX
USERID_CHECK = Cells(3, C)  ' AL3 = R3 C38
If USERID_CHECK = USERID Then
Application.ScreenUpdating = False
ActiveSheet.Range(Cells(8, C), Cells(300, C)).Select
Selection.Locked = False
ActiveSheet.Cells(3, C).Select
ActiveSheet.Cells(3, C).Interior.ColorIndex = 49
ActiveSheet.Cells(3, C).Font.ColorIndex = 2
Application.ScreenUpdating = True
MsgBox USERID_CHECK & Chr(13) & Chr(10) & "für Kommentierung freigeschaltet.", , "Benutzer erkannt"
Else
Application.ScreenUpdating = False
ActiveSheet.Range(Cells(8, C), Cells(300, C)).Select
Selection.Locked = True
ActiveSheet.Cells(3, C).Interior.ColorIndex = 15
ActiveSheet.Cells(3, C).Font.ColorIndex = 16
Spalte = C
ActiveSheet.Range(ActiveSheet.Columns(C), ActiveSheet.Columns(C)).Group
Application.ScreenUpdating = True
End If
Next C
' ab hier Freischalten der ADMIN-Zellen
' (zur Änderung der Bearbeiter in Zeile 9, Blatt Master)
Worksheets("Master").Range(Cells(3, 38), Cells(3, 50)).Select
Selection.Locked = True
Und außerdem können nur User, die im Reiter "Admin" eingetragen sind, die User im Reiter "Master" erfassen, die in den durch das Makro geschützten Spalten etwas eintragen können. Auch dies soll auf die eine Spalte AL reduziert werden, d.h. alle User, die im Reiter "Admin" eingetragen sind können den einen User in Zeile 3, Spalte AL festlegen. Die weiteren Spalten sollen offen sein.
Hier die aktuelle Programmierung:

For A = 5 To 100 ' = Zeilen 5 bis 100 im Blatt ADMIN (da stehen die IDs)
ADMINID_CHECK = Worksheets("ADMIN").Cells(A, 2)  ' B5:B100 = R5C2:R100C2
If ADMINID_CHECK = USERID Then
Application.ScreenUpdating = False
Worksheets("Master").Range(Cells(3, 38), Cells(3, 50)).Select
Selection.Locked = False
ActiveSheet.Range(Cells(3, 38), Cells(3, 50)).Interior.ColorIndex = 10
ActiveSheet.Range(Cells(3, 38), Cells(3, 50)).Font.ColorIndex = 2
Application.ScreenUpdating = True
ActiveSheet.Range("D9").Select
MsgBox ADMINID_CHECK & Chr(13) & Chr(10) & "zur Pflege der Bearbeiter freigeschaltet.", , "Admin erkannt"
Else
End If
Next A
Worksheets("Master").Select
ActiveSheet.Range("D9").Select
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
DANKE schonmal!!!

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
das einfachste ist ...
06.04.2022 09:57:48
Rudi
...überall die 50 durch 38 zu ersetzen.
z.B.
For C = 38 To 50 ' = Spalten 38-50 = AL-AX
in
For C = 38 To 38 ' = Spalten 38-38 = AL-AX
ActiveSheet.Range(Cells(3, 38), Cells(3, 50)).Interior.ColorIndex = 10
in
ActiveSheet.Range(Cells(3, 38), Cells(3, 38)).Interior.ColorIndex = 10
Ist zwar Unsinn, schadet aber auch nicht.
Gruß
Rudi
AW: das einfachste ist ...
06.04.2022 11:34:05
Mone
Danke, Rudi! Das hat schonmal so weit geklappt, dass der User nur in Spalte AL geprüft wird. Jeder kann also beliebige User in die Spalten rechts davon eintragen. Nur die Zellen unterhalb der offenen User (also der Rest der Spalte abwärts) ist noch schreibgeschützt.
Es war ja bisher so, dass nur der User etwas in der betreffenden Spalte eintragen konnte, der oben in dieser Spalte genannt war. Kann es sein, dass der User immernoch abgeprüft wird und deshalb ein Schreibschutz drauf liegt, wenn ich was eintragen will?
Anzeige
AW: das einfachste ist ...
06.04.2022 11:41:20
Rudi

Kann es sein, dass der User immernoch abgeprüft wird und deshalb ein Schreibschutz drauf liegt, wenn ich was eintragen will?
Ja.
AW: das einfachste ist ...
06.04.2022 13:18:58
Mone
hmm... und wie bekomm ich das raus? Ist bestimmt auch im Makro hinterlegt, oder?
Makro anpassen - brauche noch Hilfe!
08.04.2022 14:36:30
Mone
Kann sich das bitte nochmal jemand anschauen? Mein 1. Problem ist gelöst, d.h. es wird nur noch der User in Spalte AL gecheckt. Jeder kann also beliebige User in die Spalten rechts davon eintragen. Nur die Zellen unterhalb der jetzt offenen User (also der Rest der Spalten AM, AN, AO... etc. abwärts) ist noch schreibgeschützt.
Es war ja bisher so, dass nur der User etwas in der betreffenden Spalte eintragen konnte, der oben in dieser Spalte genannt war. Es soll aber offen sein.
Es liegt wohl noch immer ein Schreibschutz drauf. Ist das auch in dem Makro gespeichert und kann ich den Schreibschutz auf diese Zellen unterhalb der jetzt freien User aufheben?
Hier nochmal die Programmierung wie sie jetzt aussieht:

Sub Workbook_Open()
Dim i As Long
For i = 1 To Worksheets.Count
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Sheets(i).Protect userinterfaceonly:=True, Password:="JGM", AllowFormattingColumns:=True, AllowFormattingRows:=True
Sheets(i).EnableOutlining = True 'für Gliederung
Sheets(i).EnableAutoFilter = True 'für Autofilter
Next i
Sheets("Doku").Protect userinterfaceonly:=True, Password:="JGM", AllowFormattingRows:=True, AllowFormattingColumns:=True
Sheets("Logos").Unprotect Password:="JGM"
Sheets("Laufzettel").Protect userinterfaceonly:=True, Password:="JGM", AllowFormattingRows:=True, AllowFormattingColumns:=True, DrawingObjects:=False
Sheets("Notizen 1").Unprotect Password:="JGM"
Sheets("Notizen 2").Unprotect Password:="JGM"
Sheets("Notizen 3").Unprotect Password:="JGM"
' ab hier USERID lesen und Zellen sperren / entsperren für die Kommentierung
Sheets("Master").Select
Dim KeyCells As Range
Dim USERID As String
Dim C, A As Integer
Dim Spalte As Long
Dim USERID_CHECK, ADMINID_CHECK As String
USERID = Environ("Username") ' UserID auslesen und in Var speichern
ActiveSheet.Cells.ClearOutline
ActiveSheet.Columns("W:AI").Columns.Group
ActiveSheet.Columns("W:AI").Columns.Hidden = True
For C = 38 To 38 ' = Spalten 38-38 = AL-AL
USERID_CHECK = Cells(3, C)  ' AL3 = R3 C38
If USERID_CHECK = USERID Then
Application.ScreenUpdating = False
ActiveSheet.Range(Cells(8, C), Cells(350, C)).Select
Selection.Locked = False
ActiveSheet.Cells(3, C).Select
ActiveSheet.Cells(3, C).Interior.ColorIndex = 49
ActiveSheet.Cells(3, C).Font.ColorIndex = 2
Application.ScreenUpdating = True
MsgBox USERID_CHECK & Chr(13) & Chr(10) & "für Kommentierung freigeschaltet.", , "Benutzer erkannt"
Else
Application.ScreenUpdating = False
ActiveSheet.Range(Cells(8, C), Cells(350, C)).Select
Selection.Locked = True
ActiveSheet.Cells(3, C).Interior.ColorIndex = 15
ActiveSheet.Cells(3, C).Font.ColorIndex = 16
Spalte = C
ActiveSheet.Range(ActiveSheet.Columns(C), ActiveSheet.Columns(C)).Group
Application.ScreenUpdating = True
End If
Next C
' ab hier Freischalten der ADMIN-Zellen
' (zur Änderung der Bearbeiter in Zeile 9, Blatt Master)
Worksheets("Master").Range(Cells(3, 38), Cells(3, 38)).Select
Selection.Locked = True
For A = 5 To 100 ' = Zeilen 5 bis 100 im Blatt ADMIN (da stehen die IDs)
ADMINID_CHECK = Worksheets("ADMIN").Cells(A, 2)  ' B5:B100 = R5C2:R100C2
If ADMINID_CHECK = USERID Then
Application.ScreenUpdating = False
Worksheets("Master").Range(Cells(3, 38), Cells(3, 38)).Select
Selection.Locked = False
ActiveSheet.Range(Cells(3, 38), Cells(3, 38)).Interior.ColorIndex = 10
ActiveSheet.Range(Cells(3, 38), Cells(3, 38)).Font.ColorIndex = 2
Application.ScreenUpdating = True
ActiveSheet.Range("D9").Select
MsgBox ADMINID_CHECK & Chr(13) & Chr(10) & "zur Pflege der Bearbeiter freigeschaltet.", , "Admin erkannt"
Else
End If
Next A
Worksheets("Master").Select
ActiveSheet.Range("D9").Select
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
DANKEschön vorab!!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige