Bedingte Formatierung makro bei Freigegebener Tabe

Hallo,
ich weiß das dieser Problemfall oft behandelt wird. Jedoch ist dieser mal wieder ein bißchen speziell. Ich hoffe Ihr könnt mir helfen. Ich bedanke mich dann natürlich auch:wink:

Es geht um eine Freigegebene Tabelle in der 5 Benutzer verschiedene Begriffe in die Zellen eintragen.

Ist die Zelle leer bleibt die Zelle weiß
Bei „Urlaub“ = Grün
Bei „“ = grau
Bei „Arzt“ = rot

Über einen Button wird folgendes Makro ausgelöst.

Zeile = ActiveCell.Row ‚Aktuelle zeile ermittel‘
spalte = ActiveCell.Column ‚Aktuelle Spalte ermitteln‘

Range(„G4“).Select
Selection.Copy
Range(„F4:EJ26“).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Cells(Zeile, spalte).Select ‚Startzelle wieder aktiv setzen‘

Es wird praktisch die Formatierung einer Beispielzelle für alle weiteren Zellen übernommen da es vorkommen kann, dass wenn eine Zelle verschoben oder ausgeschnitten wird, sich die Formatierung ändert.

Es ist also ein „Clean“ Button der alles schön formatiert.
Leider funktioniert das bei Freigegebern Tabelle nicht.

In dsa kleine Programm soll also die bedingtre Formatierung aufgenommen werden. Dann kann die Bezugszelle auch wegfallen.

Weiterhin soll auch der Rahmen der Bezugszelle übernommen werden. (Allseitig schwarz dünn)

Gibts da ne Möglichkeit?

Hallo Dyasound,

hier eine Lösung für alle die in VBA wenig erfahrung haben. Ich hoffe, Sie können das einbauen.

Eingabe der Formeln über Format/Bedingte Formatierung:

  1. Bedingung
    Zielwert ist gleich =„arzt“ Format rot
  2. Bedingung
    Zielwert ist gleich =„urlaub“ Format grün
    3.Bedingung
    Zielwert ist gleich =" " Format grau

die Formatierung dann auf die gewünschten Zellen verteilen.

Gruß Hugo

Hallo Hugo,

danke für deine schnelle Antwort. Nur leider klappt das nicht mehr sobald die Tabelle freigegeben wird.
Es müsste daher doch also Makro programmiert werden.

Hallo,

Ich benutze excel 2007, da funktioniert der code. bis auf, das er die farbe der kopierten zelle nicht mit übernimmt.
hast bei der freigabe auch andere benutzer mit ein bezogen?

LG Fred

Hallo Dyasound,

zwei Fragen vorweg:

  1. Was steht denn in G4? Ich nehme an die bedingte Formatierung?

  2. Ich nehme an, es handelt sich um eine Art Urlaubsplan, oder? Dann verstehe ich nicht genau, warum die Formatierung dann auf E4 bis EJ von G4 übertragen werden soll.

Ich könnte mir nämlich vorstellen, dass man das ganze anders lösen kann, dafür muss ich aber erst mal genau verstehen, was Du machen möchtest.

Merci,

Dubi

sorry, da kann ich nicht helfen !

Hallo Manfred,

ja der Code funktioniert auch wie du sagst bei einer Freigegebenen Tabelle. Nur leider ohne die bedingte Formatierung. Das ist dsa Problem. In dem Code müsste also die bedingte Formatierung programmiert werden. Nur leider kann ich das nicht.

Danke

Hallo,

ja in G4 ist die bedingte Formatierung.
Genau gesagt handelt es sich um eine Kolonnenplannung. Nur wird diese ca. 200mal am Tag verändert. Ist die Tabelle nun freigegeben dann wird bei einer Veränderung die bedingte Formatierung nicht beibehalten.

Dieses Problem soll ein Makro beheben.

Das heißt, wenn man auf den Button klickt dann wird der ganze Bereich erneut formatiert.

Danke trotzdem

sorry, da kann ich nicht helfen !

Hallo Dya,

also eigentlich sehe ich nicht, warum das nicht funktionieren sollte. Wenn Du sagst, dass es bei freigegebener Tabelle nicht funktioniert, was genau meinst Du denn mit „nicht funktioniert“?

Spuckt das Makro einen Fehler aus? Passiert nichts?

Dubi

Hi,

wie ich geschrieben habe wird die bedingte Formatierung nicht ausgeführt.

Arzt=rot
Urlaub=grün
usw.

Dies ist der Fall weil bei einer Freigegebenen Tabelle keine Formatierungen (keine bedingten Formatierungen) geändert werden können.

Daher muss im Makro die bedingte Formatierung mit einprogrammiert werden.

Hallo,

bedingte Formatierung programmiert werden. Nur leider kann ich
das nicht.

Zeichne 3 makros auf.
eine für Urlaub, „“ und Arzt, wie die zelle aussehen soll.

Dann sezt eine Zellen abfrage ein.

wie:
If InStr(LCase(range(spalte&Zeile).Value), „urlaub“) >= 1 Then

Hier kommt der aufgezeichnete Makro für Urlaub hinein

elseif…

Hier kommt der aufgezeichnete Makro für „“ hinein

elseif…

Hier kommt der aufgezeichnete Makro für Arzt hinein

end if

Gruß Fred

Hallo,

danke schonmal für die Hilfe. Nur leider funktioniert es noch nicht. Anbei mal das Makro welches per Button ausgelöst wird.

Sub Makro2()

Zeile = ActiveCell.Row ‚Aktuelle zeile ermittel‘
spalte = ActiveCell.Column ‚Aktuelle Spalte ermitteln‘

If InStr(LCase(Range(F4, EJ26).Value), „Urlaub“) >= 1 Then

Selection.Interior.ColorIndex = 35
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ElseIf InStr(LCase(Range(„F4:EJ26“).Value), „Arzt“) >= 1 Then

Selection.Interior.ColorIndex = 45
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False

Else

Selection.Interior.ColorIndex = 15
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End If

Cells(Zeile, spalte).Select ‚Startzelle wieder aktiv setzen‘

End Sub

Hallo,

in dem Falle habe ich auch keine Idee, denn die Nicht-Formatierbarkeit hängt ja von der Freigabe ab, d.h. wenn’s nicht zu Fuss akzeptiert wird, Formate zu kopieren, geht’s mit nem Makro auch nicht.

Einzige Chance: Ein weiteres Makro schreiben, welches das Kolonnenplanmakro öffnet, die Daten ändert, auf eine neue Übergeordnete Tabelle schreibt und die Grunddatentabelle wieder schließt. Aber dass ich natürlich eine Nummer aufwändiger…

Sorry, andere Ideen habe ich leider auch nicht,

Dub.

Hallo,

Hier ist der funktionierende Code.
Es ist so, wenn im Bereich F4:EJ26 die Zelle verlassen wird. Spricht der Code an!

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range(„F4:EJ26“)) Is Nothing Then

If InStr(LCase(Range(Target.Address).Value), „urlaub“) >= 1 Then 'Liest die Aktuelle Zelle aus

Selection.Interior.ColorIndex = 35
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ElseIf InStr(LCase(Range(Target.Address).Value), „arzt“) >= 1 Then 'Liest die Aktuelle Zelle aus

Selection.Interior.ColorIndex = 45
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ElseIf Range(Target.Address).Value = „“ Then 'Liest die Aktuelle Zelle aus

Selection.Interior.ColorIndex = 15
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

End If

End If

End Sub

Hallo,

habe gerade nicht so viel Zeit und wollte noch mal auf bedingte Formatierungen hinweisen. Vielleicht könnnen die Dir das Problem mit den Farben schon lösen.

Gruss
Ramaka

Hallo,

ich selbst muss leider passen. Viel Erfolg bei der weiteren Recherche!

Gruß
Natator

Hallo Dyasound,

vielleicht meinst Du das folgende Makro „Format“:

Sub Format()
Zeile = ActiveCell.Row ‚Aktuelle zeile ermittel‘
Spalte = ActiveCell.Column ‚Aktuelle Spalte ermitteln‘

With ThisWorkbook.Worksheets(„Tabelle1“)
.Range(„G4“).Select
Selection.Copy
.Cells(Spalte, Zeile).Select
Selection.PasteSpecial Paste:=xlPasteFormats,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
End Sub

Für „Tabelle1“ nur noch den richtigen Namen Deiner Tabelle angeben und mit einem Button verknüpfen.