---

Hallo,

ich habe eine Zelle mit einer bedingten Formatierung versehen und möchte diese Formatierung nun auf meine ganze Tabelle übertragen. Dies geht ja ganz einfach mit dem Pinsel. Mein Problem ist nun, dass einzelne Zellen der Tabelle schon eine andere bedingte Formatierung haben und dieses wird nun überschrieben. Ich möchte aber in den betroffenen Zellen das neue bedingte Format als Bedingung2 zur schon bestehenden Bedingung1 hinzufügen. Geht das? Excel Hilfe und google bringen mich nicht weiter.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Stefan,

so etwas geht m.W. nur mit VBA.

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Schade.

Danke Beverly.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Stefan,

die bedingte Formatierung per VBA erstellen ist nicht einfach, aber es ist durchaus zu möglich. Dazu müsste ich jedoch wissen, von welcher Zelle die Bedingung auf welchen Zellbereich übertragen werden soll.

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Karin,

Zitat:

---

Dazu müsste ich jedoch wissen, von welcher Zelle die Bedingung auf welchen Zellbereich übertragen werden soll.

---

Das ist immer unterschiedlich, es ging mir bei meiner Frage nicht nur um einen einzigen Anwendungsfall. Ich habe des öfteren den Fall, dass ich in einer großen Tabelle einzelne Zellen oder auch Spalten mit einem bedingten Format versehe (z.B. wenn der Zellwert einen Grenzwert überschreitet soll er rot hervorgehoben werden oder ähnliches). Wenn ich dann für einen Zellbereich der Tabelle noch ein weiteres bedingtes Format definieren möchte überschreibe ich mir in den "Schnittmengenzellen" das schon vorhandene bedingte Format und muss in jeder dieser "Schnittmengenzellen" einzeln formatieren.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Stefan,

für einen sich ständig ändernden Bereich wüsste ich keine Lösung.

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin zusammen,
mehr oder weniger ungetestet:
Der Makrorekorder gibt mir etwas aus, wenn ich so eine Aktion mal mitschneide.
Evtl. kannst Du damit was anfangen? Also so eine Art halbautomatisches Makro: Zellen markieren, für die eine bestimmte Formatierung hinzugefügt werden soll und dann das Makro starten?
Aufzeichnung aus 2007 (Farben anpassen):

Code:

---

    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="=2", Formula2:="=4"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

---

Tipps rund um den Makrorekorder HIER und HIER.

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Excel -Suche | RuA-Suche | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zu berücksichten ist noch, dass Excel pro Zelle maximal 3 bedingte Formatierungen zulässt.
Wenn schon 3 definiert sind, was soll dann passieren?
- Soll eine überschrieben werden, wenn ja welche?
- Soll der User auswählen könnne, welche überschriben wird?
- Soll nichts passieren?

Gruss
Mike

------------------

The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin Mike,

das würde ich gerne um einen winzigen Nebensatz ergänzen wollen:

>> ... dass Excel (bis einschl. Excel 2003) pro Zelle maximal 3 bedingte Formatierungen zulässt.

Ab 2007 bist Du unbeschränkt 

Quelle: Nr 195: Maximale Anzahl Bedingungen einer bedingten Formatierung.

Aber generell hast Du natürlich Recht mit Deinen Bedenken/Hinweisen, auf was man achten sollte, wenn man es denn proggt :-)

------------------
Gruß,
runkelruebe          Herr Kann-ich-nich wohnt in der Will-ich-nich-Straße...

System-Info | Excel -Suche | RuA-Suche | FAQ-ACAD | CAD.de-Hilfe | Sei eine Antilope

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Habe noch kein Excel 2007 

Will auch ohne Beschränkungen arbeiten 

Gruss
Mike

------------------

The Power Of Dreams

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

das Problem ist nicht, dass man der Zelle/den Zellen per Code keine bedingte Formatierung zuweisen kann, sondern dass es nicht möglich ist, in einem einzigen Makroablauf sowohl die Bedingung einer Zelle auszulesen (sie soll ja nicht von Hand eingegeben werden) als auch anschließend anderen Zellen zuzuweisen - es müssten auf jeden Fall 2 getrennte Makros sein. Dazu könnte man ein UserForm erstellen, in welchem man die 2 Bereiche angibt - den dessen Bedingungn ausgelesen wird und den, dem die Formatierung zugewiesen wird, denn es soll ja so wie die "Pinselfunktion" arbeiten. Und jetzt kommen die von Mike genannten "Aber", die ebenfalls berücksichtigt werden müssen. Hinzu kommt, dass die "Auslesezelle" auch mehrere Bedingungen haben kann. Dennoch - es ist alles vom Prinzip her durchaus machbar, ist nur die Frage, in wie weit lohnt sich der Aufwand. Hinzu kommt, dass die bedingte Formatierung in 2007 wesentlich anders als in den Vorgängerversionen ist - 1. gibt es dort grundsätzlich andere Formatierungsmöglichkeiten und 2. funktioniert sie vollkommen anders.

@runkelrübe,

dein Code läuft nur unter Excel2007, denn die Vorgängerversionen kennen kein .SetFirstPriority, .TintAndShade und .StopIfTrue

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von Beverly 14.09.09 21:11:
Hi Stefan,

für einen sich ständig ändernden Bereich wüsste ich keine Lösung.

---

ich hätte in diesem Beitrag wohl besser schreiben sollen: "für einen sich ständig ändernden Bereich wüsste ich keine Lösung, die so ohne Weiteres, völlig problemlos und ohne großen Aufwand zu programmieren wäre", denn in VBA ist bekanntlich (fast) alles machbar. 

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Der Makrorekorder gibt mir etwas aus...

---

Das führt leider nicht zum Ziel. Wenn ich das aufgezeichnete Makro laufen lasse wird die bestehende Formatierung der Zellen überschrieben und nicht hinzugefügt.

Zitat:

---

Zu berücksichten ist noch, dass Excel pro Zelle maximal 3 bedingte Formatierungen zulässt.
Wenn schon 3 definiert sind, was soll dann passieren?
- Soll eine überschrieben werden, wenn ja welche?
- Soll der User auswählen könnne, welche überschriben wird?
- Soll nichts passieren?

---

Max. 3 Formate ist mir bekannt. In den allermeisten Fällen würde es mir genügen, wenn das neue Format als Bedingung 2 oder 3 zu den bestehenden 1-2 Formaten hinzugefügt wird.

Zitat:

---

es ist alles vom Prinzip her durchaus machbar, ist nur die Frage, in wie weit lohnt sich der Aufwand

---

So ist es. Ich denke der Aufwand  mit einer Userform wird für den erzielten Nutzen zu groß (da ich mich damit überhaupt nicht auskenne). Ich werde so weitermachen wie bisher und die betroffenen Zellen einzeln formatieren. Ich wollte nur sichergehen, dass ich keine einfache Möglichkeit übersehen habe, die mir die nervige Arbeit abnimmt.
Danke für das große feedback.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke für den Tip CADDoc. Aber da ich wie gesagt eine universelle Möglichkeit suche hilft mir das nicht weiter, denn ich möchte nicht in jedem Excel-sheet extra Hilfsspalten erstellen. Ich bleibe wohl bei der Handarbeit.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

XL2003-Bedingteformatierungkopieren.zip

Es gibt Dinge über die habe ich noch nie nachgedacht    
vielleicht sind die Finger auch zu schnell, bevor das Hirn zum Nachdenken angeregt wird ;-)

unten ein Code, etwas holprig - aber sollte ausreichend sein...

In der Bsp Mappe ist eine Userform -  Msgbox habe ich mal drinne gelassen - auskommentieren

Es werden max 3 Bedingungen kopiert wenn Ziel keine hat,
ansonsten Anzahl der möglichen zu kopierenden Bedingungen = 3 - Anzahl Bedingungen Ziel.

Code:

---

Sub bedingt() 'Test code zum F8 drücken ;)
Dim qcell(3) As String
Dim zcell(3) As String
Dim qfbwert(3) As Integer
Dim zfbwert(3) As Integer
On Error GoTo ERROR_HANDLING

'MsgBox UserForm1.TextBox1.Text 'Quelle
'MsgBox UserForm1.TextBox2.Text 'Ziel
   
UserForm1.TextBox1.Text = "A1" 'dummy
UserForm1.TextBox2.Text = "B1" 'dummy

For x = 1 To 3
  If Range(UserForm1.TextBox1.Text).FormatConditions(x).Formula1 <> "" Then
     qcell(x) = Range(UserForm1.TextBox1.Text).FormatConditions(x).Formula1
     qfbwert(x) = Range(UserForm1.TextBox1.Text).FormatConditions(x).Interior.ColorIndex
     MsgBox Range(UserForm1.TextBox1.Text).FormatConditions(x).Formula1
  End If
Next

For zx = 1 To 3
  If Range(UserForm1.TextBox2.Text).FormatConditions(zx).Formula1 <> "" Then
     zcell(zx) = Range(UserForm1.TextBox2.Text).FormatConditions(zx).Formula1
     zfbwert(zx) = Range(UserForm1.TextBox2.Text).FormatConditions(zx).Interior.ColorIndex
     MsgBox Range(UserForm1.TextBox2.Text).FormatConditions(zx).Formula1
  End If
Next

a = 1
For z = 1 To 3
  If zcell(z) <> "" Then
     zcell(z) = zcell(z)
     zfbwert(x) = zfbwert(x)
     MsgBox zcell(z) & "ziel"
       Else
         If qcell(a) <> "" Then
           zcell(z) = qcell(a)
           zfbwert(z) = qfbwert(a)
           MsgBox qcell(a) & "quelle zu Ziel"
           a = a + 1
         End If
  End If
Next

With Range(UserForm1.TextBox2.Text)
      .FormatConditions.Delete
      .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=zcell(1) '((zcell(1) <> "") * -1)
      .FormatConditions(1).Interior.ColorIndex = zfbwert(1)
      .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=zcell(2) '(((zcell(1) <> "") + (zcell(2) <> "")) * -1)
      .FormatConditions(2).Interior.ColorIndex = zfbwert(2)
      .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=zcell(3) '(((zcell(1) <> "") + (zcell(2) <> "") + (zcell(3) <> "")) * -1)
      .FormatConditions(3).Interior.ColorIndex = zfbwert(3)
   End With

Exit Sub

ERROR_HANDLING:
If Err.Number = 9 Or 1004 Then '<Index außerhalb des gültigen Bereichs>  &Farbe
  Resume Next
End If
MsgBox Err.Description + vbNewLine + vbNewLine + Str$(Err.Number)
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Thomas,

auch hier vielen Dank für die große Mühe die Du dir gemacht hast. Da Dein Beispielfile bei mir (vermutlich wegen meiner alten Excelversion) nicht richtig läuft, habe ich ein wenig daran herumgedoktert und folgendes geändert:

Bei dieser sub

Code:

---

Private Sub CommandButton2_Click()
UserForm1.TextBox2.Text = ActiveCell.Address
End Sub

---

habe ich das Problem, dass ich keine Zielzelle selektieren kann. D.h. ich kann, nachdem durch den Buttonklick die Userform geöffnet wurde, keine neue Zelle als Zielzelle selektieren, so dass bei klick auf "übernehmen" immer bei Quelle und Ziel die gleiche Zelle drinsteht. Ich kann mir lediglich behelfen, indem ich das activecell.address durch eine konkrete Zelle ersetze z.B.

Code:

---

UserForm1.TextBox2.Text = "g1"

---

dann läuft es. Aber das ist natürlich keine schöne Lösung.

Nochmals Danke für Deinen Einsatz, 10Üs und Hut ab.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Userform_verhalten_Showmodal.false.png

   

Zitat:

---

Original erstellt von stefga:
[B]habe ich das Problem, dass ich keine Zielzelle selektieren kann. D.h. ich kann, nachdem durch den Buttonklick die Userform geöffnet wurde, keine neue Zelle als Zielzelle selektieren, so dass bei klick auf "übernehmen" immer bei Quelle und Ziel die gleiche Zelle drinsteht. Ich kann mir lediglich behelfen, indem ich das activecell.address durch eine konkrete Zelle ersetze z.B.
[code]
UserForm1.TextBox2.Text = "g1"

---

hmmm, das ist dann mal Ѕcheisse  
mit Userformen und dem Verhalten derer und ob und wie mit XL 97, XL 2003 oder XL 07 kenne ich mich gargarnicht aus...

hmmm.. habe mal im Netz irgend eine bsp xls http://www.office-loesung.de/ftopic321650_0_0_asc.php  geladen...
um mal nachzuschauen, in einer fremden Userform, ob da nicht was wäre... dort kann ich auch nicht, nach Aufruf der Userform, auf eine Tabellenzelle klicken...

  ...   ...  

Die Stelle im Bild-> der Schalter <- ist under XL 03 dafür Verantwortlich,
das man in geöffnerter Userform auch auf auf Tabellenzellen klicken kann.
Ob und inwieweit sowas XL97 auch schon hat - kann du ja überprüfen - eventuell mal mit allen Schaltern rumspielen ^^

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Die Eigenschaft "show modal" wie in Deinem Bild taucht bei mir in Excel97 nicht auf. Aber wenn man diesen code

Code:

---

Private Sub CommandButton1_Click()
SendKeys "{Esc}"
Application.Dialogs(xlDialogOpen).Show
SendKeys "{Esc}"
Application.Dialogs(xlDialogShowToolbar).Show
End Sub

---

einfügt, den ich hier http://www.excel-vba.de/userform.htm#nonmodal  gefunden habe, dann klappt es auch in Excel97 mit dem selektieren. Somit Problem gelöst.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

bedingte_Form_uebertragen_test_3.zip

Hi @All,

Ich habe mal versucht, alle vorkommenden Bedingungen auszulesen und zu übertragen. Was nicht funktioniert sind die Muster - von diesen wird nur die Farbe übertragen, nicht das Muster selbst, obwohl es richtig erkannt wird. Ich kann nicht nachvollziehen, weshalb das so ist.

Das UserForm enthält 2 RefEdit-Controls, welche die direkte Auswahl der Zellen im Tabellenblatt ermöglichen (funktioniert auch unter Excel97), sodass die Eigenschaft ShowModal (die es erst ab Excel2000 gibt) des UserForms nicht gesetzt werden muss. Im oberen Control wird die Ausgangszelle gewählt (es ist nur 1 zugelassen). Die Zelle/Zellen/Bereiche, in die übertragen werden soll, können im unteren Control bei gedrückter Strg-Taste markiert werden.

Im Beispiel sollte als Ausgangszelle A1 und als Zielzellen die im Bereich D3:F10 bereits formatierten Zellen (einige mit bed. Formatierung, andere mit Füllfarbe) ausgewählt werden. Die Zellen im Bereich D15:F23 sind zu Vergleichszwecken identisch wie D3:F10 formatiert.

Code im UserForm (ich habe nicht alle Möglichkeiten testen können - der Code könnte also durchaus noch fehlerhaft sein):

Code:

---

Option Explicit

Private Sub cmbUebertragen_Click()
' Verweis auf Ref Edit Control muss gesetzt sein
    Dim raBereich1 As Range
    Dim raZelle As Range
    Dim varOperator
    Dim varTyp
    Dim varCondition
    Dim strFormel1 As String
    Dim strFormel2 As String
    Dim byAnzahl As Byte
    Dim byBedFormat As Byte
    Application.ScreenUpdating = False
    If refBereich1 <> "" And refBereich2.Value <> "" Then
        If InStr(refBereich1.Value, ":") = 0 Or InStr(refBereich1.Value, ";") = 0 Then
            If Range(refBereich1.Value).FormatConditions.Count > 0 Then
                For byAnzahl = 1 To Range(refBereich1.Value).FormatConditions.Count
                    varOperator = ""
                    varTyp = ""
                    strFormel1 = ""
                    strFormel2 = ""
                    varTyp = Range(refBereich1.Value).FormatConditions(byAnzahl).Type
                    strFormel1 = Range(refBereich1.Value).FormatConditions(byAnzahl).Formula1
                    On Error Resume Next
                    varOperator = Range(refBereich1.Value).FormatConditions(byAnzahl).Operator
                    On Error GoTo 0
                    If varOperator <> "" And varTyp > 1 Then strFormel2 = Range(refBereich1.Value).FormatConditions(byAnzahl).Formula2
                    For Each raZelle In Range(Application.Substitute(refBereich2.Value, ";", ","))
                        Select Case raZelle.FormatConditions.Count
                            Case 0
                                byBedFormat = 1
                            Case 1
                                byBedFormat = 2
                            Case 2
                                byBedFormat = 3
                            Case Else
                                byBedFormat = 4
                        End Select
                        If byBedFormat < 4 Then
                            If varOperator <> "" Then
                                raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1, Formula2:=strFormel2
                            Else
                                raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1
                            End If
                            With raZelle.FormatConditions(byBedFormat)
                                With .Interior
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.ColorIndex
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.Pattern <> Null Then _
                                        .Pattern = Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.Pattern
                                    .PatternColorIndex = Range(refBereich1.Value).FormatConditions(1).Interior.PatternColorIndex
                                End With
                                With .Font
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.ColorIndex
                                    .Italic = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Italic
                                    .Bold = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Bold
                                    .Underline = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Underline
                                    .Strikethrough = Range(refBereich1.Value).FormatConditions(1).Font.Strikethrough
                                End With
                                With .Borders(xlLeft)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).ColorIndex
                                End With
                                With .Borders(xlRight)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).ColorIndex
                                End With
                                With .Borders(xlTop)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).ColorIndex
                                End With
                                With .Borders(xlBottom)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).ColorIndex
                                End With
                            End With
                        End If
                    Next raZelle
                Next byAnzahl
            Else
                MsgBox "Die ausgewählte Zelle hat keine bedingte Formatierung"
            End If
        Else
            MsgBox "Bitte nur 1 Ausgangszelle wählen"
        End If
    Else
        MsgBox "Bitte eine Ausgangszelle wählen"
    End If
    Application.ScreenUpdating = True
    If byBedFormat = 4 Then MsgBox "Für einige Zellen konnte das Format nicht oder nur teilweise" & vbLf _
        & "übertragen werden, da bereits Formate vorhanden waren"
End Sub

Private Sub UserForm_Activate()
    refBereich1 = Selection.Address
End Sub

---

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

da habe ich ja was angerichtet mit meiner Frage...

Hallo Karin,

als Dankeschön für Deine große Mühe (und nicht als Aufforderung Dich noch weiter in Arbeit zu stürzen) ein feedback meinerseits:

Zitat:

---

Was nicht funktioniert sind die Muster - von diesen wird nur die Farbe übertragen, nicht das Muster selbst, obwohl es richtig erkannt wird.

---

-Bei mir wird weder Muster noch Farbe übertragen,  Schrift und Rahmen werden korrekt übertragen. Wenn ich mir anschl. die bed. Formatierung der Zelle im Menü anschaue sehe ich, dass zwar die korrekte Farbe in der Auswahlmatrix markiert ist, aber unter "Vorschau" taucht sie nicht auf.

Zitat:

---

Das UserForm enthält 2 RefEdit-Controls, welche die direkte Auswahl der Zellen im Tabellenblatt ermöglichen (funktioniert auch unter Excel97)...

---

-Jawohl, klappt wunderbar auch bei mir in Excel 97.

-wenn man statt "Zellwert ist gleich" etwas anders einstellt, z.B. "Zellwert ist zwischen" wird die Codezeile

Code:

---

raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1, Formula2:=strFormel2

---

mit "Laufzeitfehler 5: unzulässiger Prozeduraufruf" angemeckert. Aber ich vermute mal das Programm ist auch "nur" (wie auch das oben von Thomas) für die Übertragung von Formaten mit "Zellwert ist gleich" gedacht.

10üs hab ich ja schon verteilt, mehr geht leider nicht, deshalb kann ich nur nochmals Danke sagen.

------------------
Gruß
Stefan

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Stefan,

Zitat:

---

Original erstellt von stefga:
und nicht als Aufforderung Dich noch weiter in Arbeit zu stürzen

---

ich habe mich intensiv mit dem Auslesen der bedingten Formatierung beschäftigt, als ich mein Add-In für die Tabellendarstellung in Foren entwickelt habe, deshalb weiß ich, wovon ich rede und mir war klar, dass die Lösung zu deiner Frage nicht so ganz ohne Probleme wäre - deshalb auch meine Bemerkung: "in wie weit lohnt sich der Aufwand". Da aber nun Thomas hier bereits eine Lösung für einen Spezialfall vorgestellt hat, fühle ich mich ein wenig "an meiner Ehre gekratzt" 

Zitat:

---

Original erstellt von stefga:
Aber ich vermute mal das Programm ist auch "nur" (wie auch das oben von Thomas) für die Übertragung von Formaten mit "Zellwert ist gleich" gedacht.

---

nein, ich hatte vor, etwas "universelleres" zu erstellen und denn wenn du dir die bed. Formatierung in Zelle A2 anschaust siehst du, dass dort ausgewählt ist - "Formel ist", und das wird vom Code richtig erkannt und auch richtig übertragen.

Zitat:

---

Original erstellt von stefga:
Bei mir wird weder Muster noch Farbe übertragen,  Schrift und Rahmen werden korrekt übertragen.

---

Genau das meinte ich mit: "Was nicht funktioniert sind die Muster - von diesen wird nur die Farbe übertragen, nicht das Muster selbst, obwohl es richtig erkannt wird." Da das Muster nicht nicht richtig übertragen wird, wird natürlich auch die Farbe nicht angezeigt, obwohl sie richtig übertragen wird und wenn man die bed. Formatierung der Zelle anschaut auch richtig ausgewählt ist.

Womit du natürlich Recht hast ist, dass der Code noch fehlerhaft ist (hatte ich auch darauf hingewiesen - war halt schon spät gestern um alles zu testen).

Ich habe den Code noch einmal überarbeitet:

Code:

---

Private Sub cmbUebertragen_Click()
' Verweis auf Ref Edit Control muss gesetzt sein
    Dim raBereich1 As Range
    Dim raZelle As Range
    Dim varOperator
    Dim varTyp
    Dim varCondition
    Dim strFormel1 As String
    Dim strFormel2 As String
    Dim byAnzahl As Byte
    Dim byBedFormat As Byte
    Application.ScreenUpdating = False
    If refBereich1 <> "" And refBereich2.Value <> "" Then
        If InStr(refBereich1.Value, ":") = 0 Or InStr(refBereich1.Value, ";") = 0 Then
            If Range(refBereich1.Value).FormatConditions.Count > 0 Then
                For byAnzahl = 1 To Range(refBereich1.Value).FormatConditions.Count
                    varOperator = ""
                    varTyp = ""
                    strFormel1 = ""
                    strFormel2 = ""
                    varTyp = Range(refBereich1.Value).FormatConditions(byAnzahl).Type
                    strFormel1 = Range(refBereich1.Value).FormatConditions(byAnzahl).Formula1
                    On Error Resume Next
                    varOperator = Range(refBereich1.Value).FormatConditions(byAnzahl).Operator
                    On Error GoTo 0
                    If varOperator = xlBetween Or varOperator = xlNotBetween Then strFormel2 = _
                        Range(refBereich1.Value).FormatConditions(byAnzahl).Formula2
                    For Each raZelle In Range(Application.Substitute(refBereich2.Value, ";", ","))
                        Select Case raZelle.FormatConditions.Count
                            Case 0
                                byBedFormat = 1
                            Case 1
                                byBedFormat = 2
                            Case 2
                                byBedFormat = 3
                            Case Else
                                byBedFormat = 4
                        End Select
                        If byBedFormat < 4 Then
                            Select Case varTyp
                                Case 1
                                    If varOperator = xlBetween Or varOperator = xlNotBetween Then
                                        raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1, Formula2:=strFormel2
                                    Else
                                        raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1
                                    End If
                                Case 2
                                    raZelle.FormatConditions.Add Type:=varTyp, Operator:=varOperator, Formula1:=strFormel1
                            End Select
                            With raZelle.FormatConditions(byBedFormat)
                                With .Interior
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.ColorIndex
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.Pattern <> Null Then _
                                        .Pattern = Range(refBereich1.Value).FormatConditions(byAnzahl).Interior.Pattern
                                    .PatternColorIndex = Range(refBereich1.Value).FormatConditions(1).Interior.PatternColorIndex
                                End With
                                With .Font
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.ColorIndex
                                    .Italic = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Italic
                                    .Bold = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Bold
                                    .Underline = Range(refBereich1.Value).FormatConditions(byAnzahl).Font.Underline
                                    .Strikethrough = Range(refBereich1.Value).FormatConditions(1).Font.Strikethrough
                                End With
                                With .Borders(xlLeft)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlLeft).ColorIndex
                                End With
                                With .Borders(xlRight)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlRight).ColorIndex
                                End With
                                With .Borders(xlTop)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlTop).ColorIndex
                                End With
                                With .Borders(xlBottom)
                                    .LineStyle = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).LineStyle
                                    If Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).Weight <> Null Then .Weight = _
                                        Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).Weight
                                    .ColorIndex = Range(refBereich1.Value).FormatConditions(byAnzahl).Borders(xlBottom).ColorIndex
                                End With
                            End With
                        End If
                    Next raZelle
                Next byAnzahl
            Else
                MsgBox "Die ausgewählte Zelle hat keine bedingte Formatierung"
            End If
        Else
            MsgBox "Bitte nur 1 Ausgangszelle wählen"
        End If
    Else
        MsgBox "Bitte eine Ausgangszelle wählen"
    End If
    Application.ScreenUpdating = True
    If byBedFormat = 4 Then MsgBox "Für einige Zellen konnte das Format nicht oder nur teilweise" & vbLf _
        & "übertragen werden, da bereits Formate vorhanden waren"
End Sub

---

------------------
Bis später,
Karin

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP