Target an Modul übergeben

Outsider77

Outsider77

Erfahrenes Mitglied
Hallo zusammen,

ich fange das WorkSheet_Change in einem bestimmten Range ab und calle dann

Code: 
Call andere_artikel_farblich(Target.Value, Target)

Im Modul dann folgende Sub:

Code: 
Sub andere_artikel_farblich(text As String, zelle As Range)

Später in der Sub möchte ich dann mittels

Code: 
zelle.Font.ColorIndex = xlAutomatic

die Schriftfarbe setzen.
Dabei bekomme ich dann Laufzeitfehler 1004 - Anwendungs- oder Objektdefinierter Fehler!

Baue ich mir das Ganze in vereinfachter Form in einer neuen Datei nach, funktioniert alles bestens.

Habt ihr vielleicht eine Idee, woran das liegen könnte?
Bin für jede Hilfe dankbar!

Gruß Outi
 
Zuletzt bearbeitet:
Mach mal nen Break-Point im Change-Ereignis und guck dir mal an, ob Target ein gültiges Objekt ist.
Ich vermute mal, dass du ein ungültiges Target an deine Funktion übergibst.

EDIT: Setz auch nen Breakpoint in deiner Funktion und überwache Target auch dort. Irgendwas passiert mit Target (bzw. Zelle) auf dem Weg vom Change-Ereignis bis zu deiner Farbzuweisung.
 
Zuletzt bearbeitet:
Also im Change-Ereignis ist Target gleich dem Inhalt der Zellle. Also das Gleiche wie Target.Value,
das ich ja ebenfalls übergebe.

In der Sub wird Target ja zu zelle und hat ebenfalls wie im Change-Ereignis den Inhalt der Excel-Zelle.

Wenn ich VBA richtig verstehe, übergebe ich mit Target (zelle as range) das komplette Objekt,
also nicht nur den Inhalt, sondern auch die Adresse usw.

Komisch, dass ich dann bei zelle.font... einen Fehler bekomme.
 
Objekte wenn möglich immer als Referenz übergeben (ByRef). Der String kann als Kopie (ByVal) übergeben werden
Das ergibt die folgende Funktionsdefinition
Visual Basic: 
	Sub andere_artikel_farblich(ByValtext As String, ByRef zelle As Range)

Und der Aufruf:
Value notfalls zu String casten
Visual Basic: 
Call andere_artikel_farblich(cStr(Target.Value), Target)
Das geht aber nur, wenn nur ein Feld geändert wird. Ist Target mehr als ein Feld, dann ist Target.Value ein Array.
 
Outsider77 hat gesagt.:
Also im Change-Ereignis ist Target gleich dem Inhalt der Zellle. Also das Gleiche wie Target.Value,
das ich ja ebenfalls übergebe.

In der Sub wird Target ja zu zelle und hat ebenfalls wie im Change-Ereignis den Inhalt der Excel-Zelle.

Wenn ich VBA richtig verstehe, übergebe ich mit Target (zelle as range) das komplette Objekt,
also nicht nur den Inhalt, sondern auch die Adresse usw.

Komisch, dass ich dann bei zelle.font... einen Fehler bekomme.
Zum Vergrößern anklicken....

So wie deine Funktion deklariert hast übergibst du eben nicht das komplette Objekt, sondern eben nur die Adresse dorthin, so wie Yaslaw es korrekt auch beschrieben hat als ByRef (bzw. wenn man weder ByVal oder ByRef angibt ist es automatisch ByRef).

Wie gesagt: Meine Vermutung ist, dass du irgendwo auf dem Weg vom Change-Ereignis zu deiner Font-Zuweisung die Referenzierung auf das Objekt Target (bzw. Zelle) verlierst.

Kannst du mal den Code vom Change-Ereignis und deiner Sub hier reinstellen?
 
Also hier das Change-Ereignis:
Visual Basic: 
Private Sub Worksheet_Change(ByVal Target As Range)
Max_Zeilen = 54
If Artikel_alt = "" Then Artikel_alt = "leer"
Artikel = Tabelle2.Range("B1")
If Artikel = "" Then Artikel = "leer"

Dim a As Variant

Dim r As Integer
Dim c As Integer

    a = Target.Value
    If Not IsEmpty(a) Then
    
        If IsArray(a) Then
            a = a(1, 1)
        End If
        r = Target.Row
        c = Target.Column
        If (r > 10) And (r < 61) And c = 3 Or c = 8 Or c = 14 Or c = 19 Then
            If Len(a) = 3 Then
                Target.Value = Left(a, 1) & "." & ActiveSheet.Range("b1") & "-." & Right(a, 2)
            End If
        End If
        
        
        If r = 1 And c = 2 Then
        
        'Prototyperkennung
        On Error Resume Next
            If Right(Left(Target.Value, 2), 1) < 0 Or Right(Left(Target.Value, 2), 1) > 9 Then
            
                Prototyp = True
                Else
                Prototyp = False
                
            End If
        
        Application.EnableEvents = False
            If Len(a) = 7 And Prototyp = False Then
                    Target.Value = Left(a, 3) & "." & Right(Left(a, 5), 2) & "." & Right(a, 2)
               End If
            If Len(a) = 7 And Prototyp = True Then
                    Target.Value = Left(a, 2) & "." & Right(Left(a, 5), 3) & "." & Right(a, 2)
            End If
            If Artikel <> "leer" Then
            Artikel_ändern
            End If
            Application.EnableEvents = True
        End If
    End If
    
   'Saison einfügen
   Application.EnableEvents = False
   If Tabelle2.Range("B5") = "" Then
        If Artikel <> "" Then
            Saison_Zahl = Left(Artikel, 1)
            Saison_Jahr = Right(Artikel, 2)
        If Saison_Zahl = "3" Or Saison_Zahl = "5" Or Saison_Zahl = "7" Then
            Saison = "FS" & Saison_Jahr
        Else
            Saison = "HW" & Saison_Jahr
        End If
   End If
   
        If Artikel <> "leer" Then
            Tabelle2.Range("B5") = Saison
        Else
            Tabelle2.Range("B5") = ""
        End If
   End If
   Application.EnableEvents = True
   
    If Not Intersect(Target, Range("C11:S60")) Is Nothing And Target.text <> "" Then
        If Target.Column = 3 Or Target.Column = 8 Or Target.Column = 14 Or Target.Column = 19 Then
            Call andere_artikel_farblich(Target.Value, Target)
        End If
    End If
    
   
   Call Seite_bereinigen
   'Call Artikel_vergleichen
   Call Zeilen_zählen_und_füllen
   
   Call Übertrag_Tüte
   
End Sub

Und hier die Sub:

Visual Basic: 
Sub andere_artikel_farblich(text As String, zelle As Range)
Dim check_bereich As Range, check_bereich2 As Range, zellen As Range
Dim check_wert As String, alter_artikel As String
Dim alt_vorhanden As Boolean, neu_vorhanden As Boolean
Dim i As Integer, grau As Long

Set check_bereich = Tabelle2.Range("A70:A90")
check_wert = Tabelle2.Range("B1")
alter_artikel = Left(Right(text, 13), 9)

If InStr(text, check_wert) = 0 Then
    For Each zellen In check_bereich
        If zellen.Value = alter_artikel Then
            alt_vorhanden = True
            Exit For
        Else
            alt_vorhanden = False
        End If
    Next
Else
    neu_vorhanden = True
    GoTo step1
End If

Application.EnableEvents = False
If alt_vorhanden = False Then
    If Tabelle2.Cells(70, 1).Value <> "" Then
        For i = 90 To 70 Step -1
            If Tabelle2.Cells(i, 1).Value <> "" Then
                Tabelle2.Cells(i + 1, 1).Value = alter_artikel
                Tabelle2.Cells(i + 1, 2).Value = "farbe" & i + 1
                zelle.Font.ColorIndex = farbe(i + 1)
                If Left(zelle.Value, 1) <> "*" Then
                    zelle.Value = "*" & zelle.Value
                End If
                Exit For
            End If
        Next
    Else
        Tabelle2.Cells(70, 1).Value = alter_artikel
        Tabelle2.Cells(70, 2).Value = "farbe70"
        zelle.Font.ColorIndex = farbe(70)
        If Left(zelle.Value, 1) <> "*" Then
            zelle.Value = "*" & zelle.Value
        End If
    End If
End If

If alt_vorhanden = True Then
    zelle.Font.ColorIndex = farbe(Right(zellen.Offset(0, 1).Value, 2))
End If

step1:
If neu_vorhanden = True Then
    zelle.Font.ColorIndex = xlAutomatic
    If Left(zelle.Value, 1) = "*" Then
        zelle.Value = Replace(zelle.Value, "*", "")
    End If
End If

grau = 15921906
Set check_bereich2 = Tabelle2.Range("A11:S60")
For Each zellen In check_bereich2
    If zellen.Address <> zelle.Address Then
        If text = zellen.Value Then
            zellen.Interior.ColorIndex = 3
            zelle.Interior.ColorIndex = 3
            msgbox "Wert bereits vorhanden"
            zellen.Interior.Color = grau
            zelle.Interior.Color = grau
            zelle.Select
            Exit For
        End If
    End If
Next
Application.EnableEvents = True
End Sub
 
Zuletzt bearbeitet von einem Moderator:
Also auf den ersten Blick fällt mir nur eins auf, und zwar deine Sprungmarke Step1.

Verschieb das mal direkt hinter das Else in Zeile 21 des 2. Code-Blocks, und du kannst dir das ganze neu_vorhanden = True sparen.

Ich vermute mal, dass du irgendeine Zelle änderst, wo die ganzen If-Abfragen vorher nicht greifen, und er will dann einfach ab step1 weitermachen, wo er dann eine ungültige Objekt-Referenz erhält.
 
Was macht die Funktion Farbe()?

Auf welcher Zeile genau kommt der Fehler? (Debuggen)


Nicht direkt zur Sache, aber einige Kleinigkeiten
item: LEFT(RIGHT()) ist der Befehl MID()

item: Wenn du eine Schleife hast um zu prüfen ob du ein Flag auf true setzen musst, würde ich den flag zuerst auf false setzen und innerhalb der Schleife den ELSE-Teil streichen. So bist du sicher, dass die Variable mit False initialisiert wurde falls es die Schleife nie durchgeht.
Visual Basic: 
' Das folgende
    For Each zellen In check_bereich
        If zellen.Value = alter_artikel Then
            alt_vorhanden = True
            Exit For
        Else
            alt_vorhanden = False
        End If
    Next
 'durch sowas ersetzen
    For Each zellen In check_bereich
        alt_vorhanden = False
        If zellen.Value = alter_artikel Then
            alt_vorhanden = True
            Exit For
        End If
    Next
'oder noch weiter kürzen
    For Each zellen In check_bereich
        alt_vorhanden = (zellen.Value = alter_artikel)
        If alt_vorhanden = True Then Exit For
    Next

item: Vermeide Goto. Das bringt fast immer Chaos
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück