# Target an Modul übergeben



## Outsider77 (13. März 2012)

Hallo zusammen,

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


```
Call andere_artikel_farblich(Target.Value, Target)
```

Im Modul dann folgende Sub:


```
Sub andere_artikel_farblich(text As String, zelle As Range)
```

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


```
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


----------



## Zvoni (13. März 2012)

muss das nicht *xlColorIndexAutomatic* heissen?


----------



## Outsider77 (13. März 2012)

Deine Änderung hat selbe Fehlermeldung zur Folge.


----------



## Zvoni (13. März 2012)

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.


----------



## Outsider77 (13. März 2012)

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.


----------



## Yaslaw (13. März 2012)

Objekte wenn möglich immer als Referenz übergeben (ByRef). Der String kann als Kopie (ByVal) übergeben werden
Das ergibt die folgende Funktionsdefinition

```
Sub andere_artikel_farblich(ByValtext As String, ByRef zelle As Range)
```

Und der Aufruf:
Value notfalls zu String casten

```
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.


----------



## Zvoni (13. März 2012)

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.
> ...



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?


----------



## Outsider77 (13. März 2012)

Also hier das Change-Ereignis:

```
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:


```
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
```


----------



## Zvoni (13. März 2012)

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.


----------



## Yaslaw (13. März 2012)

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.

```
' 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


----------



## Zvoni (13. März 2012)

Yaslaw, wenn ich ihn richtig verstanden habe in Zeile 55 des zweiten Code-Blocks


----------



## Outsider77 (13. März 2012)

Zvoni hat gesagt.:


> 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.



Hab das so mal gemacht.




Yaslaw hat gesagt.:


> Was macht die Funktion Farbe()?


Farbe ist deklariert als Public und ist ein Array.



Yaslaw hat gesagt.:


> Auf welcher Zeile genau kommt der Fehler? (Debuggen)



Zvoni hat Recht, Fehler kommt in Zeile 55 in der Sub:

```
zelle.Font.ColorIndex = xlAutomatic
```

Die For-Schleife habe ich mal so von Dir übernommen.


----------



## Zvoni (13. März 2012)

Also ich kann am Code nichts erkennen.

Das einzigste was mir noch einfällt, wäre die Übergabe eines verbundenen Zellen-Bereichs. Da weiss ich nicht, wie sich die Eigenschaften eines Range-Objekts verhalten.

Kannst/Darfst du die Excel mal hier komplett reinstellen?


----------



## Outsider77 (13. März 2012)

Ich hab die Excel-File als Anhang beigefügt.
Versuch mal, in Zelle C11 eine 3-stellige Zahl einzugeben, etwa 101.
Wird ja per Code zu *1*.523.66.12-.*01* ergänzt.
Allerdings kommt dann der Fehler.
Die eigentliche Aufgabe der _Sub andere_artikel_farblich_ ist,
andersartige Nummern (z.B. 1.523.67.12-.01 farblich darzustellen.


----------



## Yaslaw (13. März 2012)

Hab hier 'nur' Excel 2003


----------



## Outsider77 (14. März 2012)

Also ich habe die _Sub andere_artikel_farblich_ jetzt mal in eine frühere Version der Excel-Datei eingebaut. Und jetzt funktioniert alles bestens.
Ich kann mir das nur damit erklären, dass die letzte Version irgendwie defekt ist.

Oder was meint ihr?


----------



## Zvoni (14. März 2012)

Wie ich vermutet habe: Verbundene Zellen. *ächz*

Jetzt muss ich erst mal nachlesen, wie sich Range bei verbundenen Zellen verhält. Da gibts irgendwas mit MergeArea oder sowas.

EDIT: Hab den Fehler auch als Excel 2003-File


----------



## Outsider77 (14. März 2012)

Zvoni hat gesagt.:


> Wie ich vermutet habe: Verbundene Zellen. *ächz*



Wenn, dann hatte ich die auch in der früheren Version.
Also ich spreche nicht von einer früheren Excel-Version,
sondern von einem früheren Stand der Datei!


----------



## Zvoni (14. März 2012)

Ich habs hier mal mit verbundenen Zellen getestet, und es geht. Muss also deine Datei sein.


----------



## Outsider77 (16. März 2012)

So, mittlerweile hab ich herausgefunden, ab wann die Datei "defekt" war.
Ich habe irgendwann vereinzelte Zellen sperren wollen und habe dazu den Blattschutz aktiviert.
Und das war der Moment, ab dem nichts mehr funktionert hat.
Wenn man in der von mir angehängten Datei den Blattschutz aufhebt, funktioniert es wieder (Anhang geändert).
Frage ist jetzt nur, warum es bei aktivem Blattschutz zu solch einer Fehlermeldung kommt?


----------



## Zvoni (16. März 2012)

Als Vermutung: Weil der Arbeitsblatt-Schutz durchvererbt wird.

In der Excel-Hilfe konnte ich etwas mit Namen "AllowEditRanges-Auflistung" finden.

Stoppe mal bei der geschützten Datei per Breakpoint in der Funktion, und schau dir mal das Protection-Objekt und ihre Kinder an. Vielleicht findest du ja da etwas.


----------

