AW: Excel Feld beschreiben
01.03.2021 17:13:53
Christoph
Hallo,
anbei das aktuelle Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strBlattname As String
If Target.Count = 1 Then
If Target.Column = 1 And Target.Row > 7 Then
If Target "" Then
If Target = Target.Offset(, 1) Or Target.Offset(, 1) = "" Then
strBlattname = Target
strBlattname = LegalSheetName(strBlattname)
For Each Worksheet In ThisWorkbook.Worksheets
If CStr(Worksheet.Name) = strBlattname Then
MsgBox "Hinweis: Das Blatt " & strBlattname & " gibt es schon."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Next Worksheet
Worksheets.Add after:=Worksheets(Sheets.Count)
ActiveSheet.Name = strBlattname
ActiveSheet.Range("A2") = "Verantwortlicher:"
ActiveSheet.Range("A4") = "PSP-Element"
ActiveSheet.Range("B4") = "BANF Antragsteller"
ActiveSheet.Range("C4") = "BANF Nummer"
ActiveSheet.Range("D4") = "Bestell-Nummer"
ActiveSheet.Range("E4") = "Beschreibung"
ActiveSheet.Range("F4") = "Bedarf melden?" & Chr(10) & "J/N"
ActiveSheet.Range("G4") = "Planwert"
ActiveSheet.Range("G2") = "Planwert"
ActiveSheet.Range("H4") = "Bestellwert"
ActiveSheet.Range("H2") = "Bestellwert"
ActiveSheet.Range("J4") = "Hilfsspalte" & Chr(10) & "Bestellwert"
ActiveSheet.Range("J2") = "tatsächlich" & Chr(10) & "nötiger" & Chr(10) & " _
Bestellwert"
ActiveSheet.Range("I2") = "Differenz" & Chr(10) & "Bestellwert/" & Chr(10) & " _
Planwert"
ActiveSheet.Range("I4") = "Differenz" & Chr(10) & "Bestellwert/" & Chr(10) & " _
Planwert"
ActiveSheet.Range("I6").FormulaR1C1 = "=IF(RC[-1]"""",SUM(RC[-2]-RC[-1]),"""") _
ActiveSheet.Range("I6").AutoFill Destination:=ActiveSheet.Range("I6:I997"), _
Type:=xlFillDefault
ActiveSheet.Range("J6").FormulaR1C1 = "=IF(R[1]C[-3]=""j"",1,0)*R[1]C"
ActiveSheet.Range("J6").AutoFill Destination:=ActiveSheet.Range("J6:J997"), _
Type:=xlFillDefault
ActiveSheet.Range("K4") = "2021"
ActiveSheet.Range("L4") = "2022"
ActiveSheet.Range("M4") = "2023"
ActiveSheet.Range("N4") = "2024"
ActiveSheet.Range("K2") = "2021"
ActiveSheet.Range("L2") = "2022"
ActiveSheet.Range("M2") = "2023"
ActiveSheet.Range("N2") = "2024"
ActiveSheet.Range("O4") = "Lieferant"
ActiveSheet.Range("C1") = "Budget"
ActiveSheet.Range("D1") = "=INDEX(Übersicht!C14,MID(CELL(""dateiname"",R1C1), _
FIND(""]"",CELL(""dateiname"",R1C1))+1,255)+7)"
ActiveSheet.Range("C2") = "Verfügbar"
ActiveSheet.Range("D2") = "=D1-SUM(K3+L3+M3+N3)"
ActiveSheet.Range("G3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("H3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("I3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("J3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("K3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("L3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("M3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("N3") = "=Sum(R[3]C:R[997]C)"
ActiveSheet.Range("A6:A997").HorizontalAlignment = xlCenter
ActiveSheet.Range("A6:A997").VerticalAlignment = xlCenter
ActiveSheet.Range("A1:P5").HorizontalAlignment = xlCenter
ActiveSheet.Range("A1:P5").VerticalAlignment = xlCenter
ActiveSheet.Range("A6:A997") = "=INDEX(Übersicht!C33,MID(CELL(""dateiname"", _
R1C1),FIND(""]"",CELL(""dateiname"",R1C1))+1,255)+7)"
ActiveSheet.Range("A3") = "=INDEX(Übersicht!C12,MID(CELL(""dateiname"",R1C1), _
FIND(""]"",CELL(""dateiname"",R1C1))+1,255)+7)"
ActiveSheet.Range("A1:P5").Interior.Color = RGB(191, 191, 191)
ActiveSheet.Range("A6:A997").Interior.Color = RGB(191, 191, 191)
ActiveSheet.Range("I6:J997").Interior.Color = RGB(191, 191, 191)
ActiveSheet.Range("A2:A3").Interior.Color = RGB(255, 255, 0)
ActiveSheet.Columns("A:P").EntireColumn.AutoFit
ActiveSheet.Unprotect
ActiveSheet.Cells.Locked = False
ActiveSheet.Range("A1:P5").Locked = True
ActiveSheet.Range("A6:A997").Locked = True
ActiveSheet.Range("I6:J997").Locked = True
ActiveSheet.Protect
Application.EnableEvents = False
Target.Resize(1, 2) = strBlattname
Application.EnableEvents = True
Else
strBlattname = Target
strBlattname = LegalSheetName(strBlattname)
For Each Worksheet In ThisWorkbook.Worksheets
If CStr(Worksheet.Name) = strBlattname Then
MsgBox "Hinweis: Das Blatt " & strBlattname & " gibt es schon."
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
If CStr(Worksheet.Name) = CStr(Target.Offset(, 1)) Then
Worksheet.Name = strBlattname
Application.EnableEvents = False
Target.Resize(1, 2) = strBlattname
Application.EnableEvents = True
Exit For
End If
Next Worksheet
End If
End If
End If
End If
End Sub
Reicht dies?