siehe Anhang:
Der Zellinhalt von A3 ist bedingt formatiert (Schriftfarbe grün, wenn TEIL(A3;5;3)>0)
Wie kann dieses Format auf den Wert im Textfeld (F2:G5) übertragen werden ?
Hardbopper
[
attachment=27421]
Hallöchen,
reicht Dir als Ansatz schon
ActiveCell.DisplayFormat.Interior.Color
Hi,
zu =TEIL(A3;5;3)>0
?
wann wird den das Ergebnis nicht Grün?
die Formel ergibt (für mich jedenfalls ) keinen Sinn..
Hallo,
ha so etwas noch nie versucht, gehe aber davon aus, dass man ein Textfeld nicht mit bedingter Formatierung verändern kann.
Hallo, :19:
bezogen auf
deine Beispieldatei: :21:
Code:
Tabelle1.Shapes(1).TextFrame.Characters.Font.Color = Tabelle1.Range("A3").DisplayFormat.Font.Color
Wenn du das über "
Private Sub Worksheet_Calculate()" machst, kannst du
beide "
Tabelle1." rauslöschen.
Hast du
mehrere Textfelder, dann arbeite mit dem richtigen
Index, oder dem
Namen des entsprechenden
Textfeldes.
Hallo Chris-ka,
Die Formel in A3 enthält auch Textteile. Für die bedingte Formatierung muss also das reine Rechenergebnis A1-SA2 zugrunde gelegt werden. Andererseits erspare ich mir mit dem formulierten Inhalt von A3 eine zusätzlichen Schritt, um zu dem Text zu kommen, den ich im Textfeld sehen möchte.
An alle anderen: Ich werde mich in Ruhe an den angebotenen Lösungsvorschlägen versuchen.
Vorab aber schon einmal herzlichen Dank.
Hardbopper
Guten Morgen
welche Bedingung soll den zutreffen damit "Grün" erscheint?
soll der Wert größer als 100 sein?
ich mache das mal in der Demo...
Ohne bed. Formatierung da reicht auch
[Farbe10][>100]"Ø ="#.##0 "kWh";"Ø ="#.##0 "kWh"
als "normale" Formatierung
und einem Eventmakro
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("A1:A2")
If Not Intersect(rng, Target) Is Nothing Then
Shapes(1).TextFrame.Characters.Font.Color = Range("A3").DisplayFormat.Font.Color
End If
End Sub
[
attachment=27438]
Hallo Case,
es funktioniert alles (auch in einer Tabelle mit mehreren Textfeldern) einwandfrei, danke !
Zu Klaus-Dieter: ein Textfeld kann selbstverständlich nicht bedingt formatiert werden, sondern diese Formatierung muss in der zugrunde liegenden Zelle (hier: A3) erfolgen.
Hardbopper
Hallo Case,
ich muss doch noch einmal Deine Hilfe in Anspruch nehmen. Wie bereits berichtet, funktioniert Dein Lösungsvorschlag auch in einer Tabelle mit mehreren Textfeldern. Wenn ich aber versuche, das Ganze auf eine Tabelle zu übertragen, die Bestandteil einer Arbeitsmappe ist, scheitere ich.
Es geht um die Arbeitsmappe "Gasverbrauch" und dort um das Arbeitsblatt "Regressionsmodell". Ich habe die bedingte Formatierung der Zelle Z15 absichtlich verändert, um kontrollieren zu können, ob das Makro funktioniert, die Farbe des maßgeblichen Textfeldes ist aber nach wie vor grün, obwohl sie sich zu violett verändern müsste. Auch ein Austausch der shape-Nummern hat kein Ergebnis gebracht.
Ich hoffe, Dich nicht über Gebühr in Anspruch zu nehmen.
Die Arbeitsmappe habe ich beigefügt.
[
attachment=27464]
Hardbopper
Moin moin, :19:
du hast auf dem Tabellenblatt "
Regressionsmodell"
mehrere nicht genutzte Textfelder. In "
N27" liegen
zwei übereinander. :21:
[
attachment=27466]
Kannst du auch sehen, indem du auf...
"
Start - Bearbeiten - Suchen und Auswählen - Gehe zu... - Inhalte... - Objekte - OK" gehst.
Oder du führst folgendes Makro aus: :21:
Code:
Option Explicit
Public Sub Shape_Info()
Dim wksSheetNew As Worksheet
Dim wksSheet As Worksheet
Dim wksTMP As Worksheet
Dim shpShape As Shape
Dim lngRow As Long
On Error GoTo Fin
Application.ScreenUpdating = False
For Each wksTMP In ThisWorkbook.Worksheets
If wksTMP.Name = "Info_Shapes" Then
Application.DisplayAlerts = False
wksTMP.Delete
Application.DisplayAlerts = True
End If
Next wksTMP
Set wksSheet = Tabelle10
If wksSheet.Shapes.Count < 1 Then
MsgBox "No Shapes in the current worksheet!"
Exit Sub
End If
Set wksSheetNew = Worksheets.Add(Before:=Worksheets(1))
wksSheetNew.Name = "Info_Shapes"
For Each shpShape In wksSheet.Shapes
With wksSheetNew
.Cells(lngRow + 1, 2) = shpShape.Name
.Cells(lngRow + 1, 2).Font.Bold = True
.Cells(lngRow + 1, 2).HorizontalAlignment = xlRight
.Cells(lngRow + 1, 1) = "Name"
.Cells(lngRow + 2, 2) = shpShape.Type
.Cells(lngRow + 2, 1) = "Type"
.Cells(lngRow + 3, 2) = shpShape.AutoShapeType
.Cells(lngRow + 3, 1) = "AutoShapeType"
.Cells(lngRow + 4, 2) = shpShape.Height
.Cells(lngRow + 4, 1) = "Height"
.Cells(lngRow + 5, 2) = shpShape.Width
.Cells(lngRow + 5, 1) = "Width"
.Cells(lngRow + 6, 2) = shpShape.Top
.Cells(lngRow + 6, 1) = "Top"
.Cells(lngRow + 7, 2) = shpShape.Left
.Cells(lngRow + 7, 1) = "Left"
.Cells(lngRow + 8, 2) = shpShape.TopLeftCell.Column
.Cells(lngRow + 8, 1) = "TopLeftCell.Column"
.Cells(lngRow + 9, 2) = shpShape.TopLeftCell.Row
.Cells(lngRow + 9, 1) = "TopLeftCell.Row"
.Cells(lngRow + 10, 2) = shpShape.TopLeftCell.Address(0, 0)
.Cells(lngRow + 10, 1) = "TopLeftCell.Address"
.Cells(lngRow + 10, 2).HorizontalAlignment = xlRight
If shpShape.OnAction = "" Then
.Cells(lngRow + 11, 2) = "No macro assigned!"
Else
.Cells(lngRow + 11, 2) = shpShape.OnAction
.Cells(lngRow + 11, 2).Font.ColorIndex = 3
End If
.Cells(lngRow + 11, 1) = "OnAction"
.Cells(lngRow + 11, 2).HorizontalAlignment = xlRight
lngRow = lngRow + 12
End With
Next
With wksSheetNew
.Range(Cells(1, 1), _
Cells(.Rows.Count, 1).End(xlUp)).Rows.Font.Bold = True
.Columns("A:B").AutoFit
End With
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wksSheetNew = Nothing
Set wksSheet = Nothing
End Sub
Du kannst das auch über den Namen des Shapes machen. Dieser Name wird automatisch beim Erstellen vergeben und du kannst ihn dir im Namensfeld (links oben, vor der Bearbeitungszeile) anzeigen und dort auch ändern (hierzu einfach das Shape selektieren und den angezeigten Namen überschreiben).
Mit Name: :21:
Code:
Tabelle10.Shapes("TextBox 8").TextFrame.Characters.Font.Color = Tabelle10.Range("Z15").DisplayFormat.Font.Color