AW: Code in Module, Hilfe !
21.02.2022 11:52:58
UweD
Hallo
Ich hab mir nicht alles angesehen...
In den einzelnen Blättern reicht das...
Private Sub CommandButton1_Click()
Call CB1
End Sub
Private Sub CommandButton2_Click()
Call CB2
End Sub
Private Sub CommandButton3_Click()
Call CB3
End Sub
Private Sub CommandButton4_Click()
Call CB4
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C5:AG128")) Is Nothing Then MsgBox "Fehler!", vbCritical
Cancel = True
If Not Intersect(ActiveCell, Range("C5:AG128")) Is Nothing Then
Cancel = True
CommandBars("MyCommandBar").ShowPopup
End If
End Sub
In ein Modul dann das hier
Option Explicit
Public Blatt As Worksheet
Public i As Long, Zeile As Long
Public Abteilung As String, Name As String
Public LfdNr As Integer
Public OldRow As Variant, Indx As Integer
Public OldRow1, RowCnt
Sub CB1()
On Error GoTo Fehler
If ActiveSheet.ProtectContents = False Then GoTo Fehler
ActiveSheet.Unprotect
ActiveSheet.CommandButton2.Visible = True
ActiveSheet.CommandButton3.Visible = True
ActiveSheet.CommandButton4.Visible = True
Sheets("Grundeinstellungen").Visible = True
Exit Sub
Fehler:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, Password:=("KdoSAN")
ActiveSheet.CommandButton2.Visible = False
ActiveSheet.CommandButton3.Visible = False
ActiveSheet.CommandButton4.Visible = False
Sheets("Grundeinstellungen").Visible = False
On Error GoTo 0
End Sub
Sub CB2()
Blaetterfreigeben
Zeile = Application.InputBox("welche Zeile loeschen?", "Zeile loeschen", Type:=1)
For i = ActiveSheet.Index To Worksheets.Count 'von aktuellem Blatt bis letztes Blatt
Worksheets(i).Rows(Zeile).Delete
Next
End Sub
Sub CB3()
Blaetterfreigeben
Zeile = Application.InputBox("Vor welcher Zeile einfuegen?", "Zeile einfuegen", 0, Type:=1)
If Zeile = 0 Then Exit Sub
Application.EnableEvents = False
Abteilung = Application.InputBox("Abtl.", "Abt. einfuegen", Type:=2)
Name = Application.InputBox("Name", "Name eintragen", Type:=2)
For i = ActiveSheet.Index To Worksheets.Count
With Worksheets(i)
.Rows(Zeile).Insert xlDown
.Cells(Zeile, 1) = Abteilung
.Cells(Zeile, 2) = Name
End With
Next
Application.EnableEvents = True
End Sub
Sub CB4()
On Error GoTo 0
Blaetterfreigeben
Indx = ActiveSheet.Index 'ActiveSheet Index merken
OldRow = Selection.Address(0) 'ausgewählte Zeilen Adresse (mit ":")
RowCnt = Selection.Rows.Count 'Anzahl Zeilen
Selection.Select
If InStr(OldRow, ":") = 0 Then MsgBox "Keine ganze Zeile ausgewählt" & vbLf & "Zeile zuerst bitte selektieren": Exit Sub
Zeile = Application.InputBox("in welche Zeile verschieben?", "Zeile " & OldRow & " verschieben", Type:=1)
If Zeile = Empty Then Exit Sub
On Error GoTo Fehler
Application.ScreenUpdating = False
Application.EnableEvents = False
'Zeilenkorrektur verursacht durch Cut!
OldRow1 = Left(OldRow, InStr(OldRow, ":") - 1)
If Zeile > OldRow1 Then Zeile = Zeile + RowCnt + 1
For i = ActiveSheet.Index To Worksheets.Count
With Worksheets(i)
.Select
.Rows(OldRow).Cut
.Rows(Zeile).Insert shift:=xlDown
End With
Next
Fehler: 'und Makro Ende
Worksheets(Indx).Select
Application.EnableEvents = True
If Err > 0 Then MsgBox "unerwarteter Fehler" & vbLf & Error()
End Sub
Sub Blaetterfreigeben()
For Each Blatt In ActiveWorkbook.Sheets
Blatt.Unprotect ("KdoSAN")
Next
End Sub
LG UweD