Hallo Franz_Farben in Formen _Teil_II

Hallo Franz,
wie immer eine gute Lösung!
Leider habe ich bei der Anwendung vielzuviele sekletioen durchzuführen.
Die Inbox (zurück zur aktiven Zelle)benötige eigentlich nicht.
Wenn ich eine Zahl eingegeben habe, soll sich die Farbe ändern.
...bis hier ist alles Prima und genauso wie ich es benötige.
Nach der Änderung des Zelleninhaltes fragt mich das Makro ab:
"zurück zur aktiven Zelle" ja/nein
Kann das nicht einfach herausgenommen werden?
Also egal welche Zahl ich in dem Arbeitsbereich ändere, die Farbe soll sich ändern.
Eine Bestätigung der Änderung der Zelle oder Feldgruppe benötige ich nicht.
Das Ganze System wird sonst bedienungsunfreundlich weil ich ja bis zu 400 Merkmale habe.
Eine Anpassung währe super hilfreich! Danke!
Gruß
Lemmi

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lemmi,
ist es denn so schwer sich mal ein wenig mit den Makrozeilen zu beschäftigen, um dann die nicht benötigten Zeilen zu löschen?
Gruß
Franz


'Code unter dem Tabellenmodul der Tabelle mit den sich ändernden Zellen
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Long, rngRow As Range
With Target
Select Case .Column
Case 4 To 12 'Spalten D bis L
'geänderte Zeilen abarbeiten
For Each rngRow In Target.Rows
Zeile = rngRow.Row
Select Case Zeile
Case 8 To 27 'Zeilenbereich mit Werten zu feldgrupen
'prüfen, ob GruppeName eingetragen und Farbwerte für alle 9 Felder eingetragen
If Cells(Zeile, 3)  "" And _
Application.WorksheetFunction.Count(Range(Cells(Zeile, 4), _
Cells(Zeile, 12))) = 9 Then
Call prcGruppeFaerben(strGrpName:=Cells(Zeile, 3).Text, _
rngFarben:=Range(Cells(Zeile, 4), Cells(Zeile, 12)))
End If
Case Else
'do nothing
End Select
Next rngRow
Case Else
'do nothing
End Select
End With
End Sub
'Code in einem allgemeinen Modul oder im gleichen Modul wie obiges Ereignismakro
Sub prcGruppeFaerben(strGrpName As String, rngFarben As Range)
Dim objGruppe As Shape, objShape As Shape, intI
On Error GoTo Fehler
Set objGruppe = rngFarben.Parent.Shapes(strGrpName)
For intI = 0 To 8
Set objShape = objGruppe.GroupItems("Feld_" & Format(intI, "00"))
Select Case rngFarben.Cells(1, intI + 1)
Case 0
objShape.Fill.Visible = False
Case 1
objShape.Fill.Visible = True
objShape.Fill.ForeColor.RGB = RGB(0, 176, 80) 'dunkel grün
Case 2
objShape.Fill.Visible = True
objShape.Fill.ForeColor.RGB = RGB(255, 255, 0) 'gelb
Case 3
objShape.Fill.Visible = True
objShape.Fill.ForeColor.RGB = RGB(255, 0, 0) 'rot
End Select
Next intI
Fehler:
With Err
Select Case .Number
Case 0 'do nothing
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf _
& "Gruppen-Name Shape: " & strGrpName & vbLf _
& "  oder " & vbLf _
& "Gruppenelement: Feld_" & intI
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Hallo Franz_Farben in Formen _Teil_II

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread