Office: autoform mit einer Funtion verbinden II

Ich versuche dir bei deinem Problem zu helfen und muss mich von dir so anmachen lassen?! Da fragt sich doch wirklich, wer hier eine Entschuldigung erwarten kann. Ich stelle dir Fragen (die du nicht beantwortest!), weil es Unklarheiten gibt, und eine Datei ohne konkrete Erläuterung - und du wunderst dich, dass ich so nicht weitermachen kann? WIE soll ich denn bitteschön helfen?

 

@Tommes,

willkommen im Forum. In diesem Forum sind alle Fragen kostenfrei.
Alle Helfer/-innen antworten kostenfrei und in Ihrer Freizeit. Mehr noch, sie haben schon seit Jahren Freizeit geopfert um ihr Wissen zu erweitern und stellen hier dieses Wissen gern zur Verfügung. Wie gesagt, alles kostenfrei für die Frager/-innen.
Und wenn eine Fragestellung unklar ist, dann wird halt nachgefragt. Je genauer die Darstellung (am besten in einer Bsp.-Datei mit SOLL und IST), um so besser ist es für den Antwortgeber möglich, den Wunsch des Ergebnisses nachzuvollziehen!
Wenn ein Antworter nicht weiterhelfen kann oder will, weil seitens des Fragestellers keine weiterführenden Antworten gegeneb werden, dann respektiere bitte dies.

Im Übrigen kann man sich nicht selbst entschulden!;)

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A6") Then 'Wert steht in Zelle xyz
Hafenplan.Shapes("Abgerundetes Rechteck 4").Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End If
End Sub

Private Function fctFarbe(dblWert As Double) As Byte
Select Case dblWert
Case Is = 1 'Werte und Relationen anpassen
fctFarbe = 11 'Farbwerte entsprechend ändern
Case Is = 2
fctFarbe = 5
Case Is = 3
fctFarbe = 4
Case Else
fctFarbe = 9
End Select
End Function

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A6") Then 'Wert steht in Zelle xyz
Hafenplan.Shapes("Abgerundetes Rechteck 4").Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End If
End Sub

Private Function fctFarbe(dblWert As Double) As Byte
Select Case dblWert
Case Is = 1 'Werte und Relationen anpassen
fctFarbe = 11 'Farbwerte entsprechend ändern
Case Is = 2
fctFarbe = 5
Case Is = 3
fctFarbe = 4
Case Else
fctFarbe = 9
End Select
End Function



erst mal kurz code....bevor er mir huschen geht....muß dazu gleich noch was schreiben...

 

aaaaaaaaaaaaaaaah, Fehler, der war doppelt: so ist richtig:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A6") Then 'Wert steht in Zelle xyz
Hafenplan.Shapes("Abgerundetes Rechteck 4").Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
End If
End Sub

Private Function fctFarbe(dblWert As Double) As Byte
Select Case dblWert
Case Is = 1 'Werte und Relationen anpassen
fctFarbe = 11 'Farbwerte entsprechend ändern
Case Is = 2
fctFarbe = 5
Case Is = 3
fctFarbe = 4
Case Else
fctFarbe = 9
End Select
End Function

 

so....moment noch.......muß dazu noch was schreiben

 

Wenn du das nächstemal einen Code postest, dann gehe zuerst auf den Schalter "Erweitert" unter dem Antwortfenster. Ddanach werden dir oberhalb des Antwortfensters mehrere Schalter zum Formatiern des Beitragtextest angzeigt, so u.a. auch die Raute # (dtritter schalter von rechts) - damit kann man strukturiert geschriebenen Code auch strukturiert im Beitrag anzeigen lassen, was ihn wesentlich besser lesbar macht.

Bis später,
Karin

 

test:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Range("A6") Then    'Wert steht in Zelle xyz
         Hafenplan.Shapes("Abgerundetes Rechteck 4").Fill.ForeColor.SchemeColor = fctFarbe(Target.Value)
    End If
End Sub

Private Function fctFarbe(dblWert As Double) As Byte
    Select Case dblWert
    Case Is = 1        'Werte und Relationen anpassen
        fctFarbe = 11   'Farbwerte entsprechend ändern
    Case Is = 2
        fctFarbe = 5
    Case Is = 3
        fctFarbe = 4
    Case Else
        fctFarbe = 9
    End Select
End Function

 

zur Beschreibung:

Ich habe eine excel-datei Version 2003.
Darin ist eine Übersichtstabelle "Hafenplan" und geplant bis zu 160 weitere Tabellen "Platz x" mit Einzelinformationen.
Obiger Code steht in den x Tabellen und bei Eingabe einer Zahl von 1 bis 3 erhält das "abgerundeten Rechteck x" auf dem anderen Übersichtsblatt eine andere Farbe.
Der Code oben funktioniert aber nur, wenn ich eine Zahl in das Feld A6 eintippe.

Sobald ich das Feld A6 per Formel automatisch berechnen lasse funktioniert das nicht mehr. Ich ahne, dass hier ein anderes Eregnis als das Eintippen als Auslöser programmiert werden muß. An der Stelle hänge ich und bitte um Hilfe.

Gruß Thomas

 

Hi Thomas,

in dem Fall musst du die Eingabe in die Zellen überwachen, aus denen die Formel ihre Daten erhält.

Bis später,
Karin

 

Das kann ich nicht, da ich die Zelle nicht kenne, da sieirgendwo in der Datenbank stehen kann. Ich hole mir den letzten Status mit dem Kniff:

=VERWEIS(2;1/(Liegeplatzstatus<>"");Liegeplatzstatus)


heraus.

 

Was ist Liegplatzstatus - der Name einer Zelle?

Bis später
Karin

 

minute...... muß gucken, wie ich es beschreibe

 

auf dem Tabellenblatt "Platz x" finden sich Informationen über den jeweiligen Platz.
Diese Informationenn stehen in einem Datenbankbereich "Datenbank" und werden dort über die Maske oder von Hand zeilenweise eingetragen.

Eine Spalte gibt mir Auskunft über den Status eines Platzes, ob er reserviert ist, frei, oder belegt. Diese Spalte hat als Namen "Liegeplatzstatus".

Um nun zu wissen, welches der letzte Belegt-Status eines Liegeplatzes ist, werte ich in einer Zelle mit dem Namen "Belegtstatus" den letzten Eintrag in der Detenbank über obige Formel aus. Da steht dan drinne ob belegt, frei oder reserviert.

Und jetzt möchte ich mit meinem Code halt in der Übersicht eine Form blau, rot oder gelb einfärben, um mit einem Blick einen Grafischen Überblick zu haben, was ist belegt und was frei.

Gruß

 

in dem anderen Thread reden die beiden darüber statt "change" besser "calc" zu überwachen... kennst du sowas? mir fehlt die richtige syntax um das umzusetzen.

Gruß

 

Wenn ich den Code ändere in "Calculate", dann bruingt er Fehlermeldung "Target" nicht definiert:

Code:

Private Sub Worksheet_Calculate()
    If Target = Range("A5") Then    'Wert steht in Zelle xyz