Auswahlliste - Code funktioniert nur einmal

Computer: Software & Programmierung Visual Basic
#1

Hallo!

Folgende Situation:
Ich habe eine Auswahlliste definiert mit fünf Auswahlmöglichkeiten. Je nachdem welche gewählt wird, erscheint in der Zelle daneben ein Bild. Der Code funktioniert bei mir einwandfrei, jedoch nur so lange bis ich den gleichen Code in einer anderen Spalte noch einmal anwenden möchte. Ich hoffe, ich hab mein Problem annähernd verständlich erklärt (-;

Hier mein Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Dim Bild As Shape
Dim PicName, ZellenName As String

For Each Shape In Me.Shapes
If Shape.Type = msoPicture Then
Shape.Delete
End If
Next

For i = 3 To 300
ZellenName = „V“ & i
PicName = „PicG“ & i
With Range(ZellenName)
For Each Bild In Sheets(„Trend“).Shapes

If Bild.Name = .Text Then
Bild.Visible = True
Bild.Copy
Sheets(„ORG“).Paste Range(ZellenName)
Me.Shapes(.Text).Name = PicName
Me.Shapes(PicName).Left = .Left
Me.Shapes(PicName).Top = .Top
End If
Next Bild

End With

Next i

For i = 3 To 300
ZellenName = „Y“ & i
PicName = „PicG“ & i
With Range(ZellenName)
For Each Bild In Sheets(„Trend“).Shapes

If Bild.Name = .Text Then
Bild.Visible = True
Bild.Copy
Sheets(„ORG“).Paste Range(ZellenName)
Me.Shapes(.Text).Name = PicName
Me.Shapes(PicName).Left = .Left
Me.Shapes(PicName).Top = .Top
End If
Next Bild

End With

Next i

Application.ScreenUpdating = True
End Sub

Danke schon mal!
Lg Elke

#2

[MOD] Programm und Version
Hallo,

Ich hoffe, ich hab mein Problem annähernd verständlich erklärt (-;

fast. :smile: Daß es um Excel-VBA geht, kann ich noch am Code sehen, aber oft ist die Version interessant. Welches Excel?

Gruß, Rainer

#3

Oh hab ich ganz vergessen
Excel 2002

Nun WIRKLICH verständlich? (-:

#4

Excel 2002 VBA … wer hilft?
Hi Elke,

Oh hab ich ganz vergessen
Excel 2002

macht ja nichts, dafür bin ich ja da. :smile:

Nun WIRKLICH verständlich? (-:

Ja. Aber ich kann Dir leider nicht helfen, nun müssen wir auf die Experten warten.

Gruß, Rainer

#5

Hi Elke,

Ich habe eine Auswahlliste definiert mit fünf
Auswahlmöglichkeiten. Je nachdem welche gewählt wird,
erscheint in der Zelle daneben ein Bild. Der Code funktioniert
bei mir einwandfrei, jedoch nur so lange bis ich den gleichen
Code in einer anderen Spalte noch einmal anwenden möchte. Ich
hoffe, ich hab mein Problem annähernd verständlich erklärt (-;

was genau meinst du mit Auswahlliste?

Nachstehend siehst du wie dein Code lesbar aussieht wenn man den pre-Tag benutzt, (tue so als ob du hierdrauf antworten willst, dann erscheint unter dem Eingabefeld die Hilfe zu den Tags, bzw. schau in die w-w–Hilfe).

Den Lapsus bei Dim habe ich beseitigt, jede Variable braucht ein „as“ sonst ist sie Variant deklariert wie bei dir PicName.

Jetzt, wo der Code lesbar ist, sieht man, daß da im wesentlichen 2 Schleifen sind die sich nur in einer Zeile unterscheiden, das schreit irgendwie danach dies auszulagern in eine Sub und als parameter dann „V“ und „Y“ mitzugeben o.ä. Okay, hat mit der Anfrage nix zu tun.

Jetzt zu deiner Anfrage:

Dein Code läuft bei Änderung in jeder beliebigen Zelle los, ist das so gewollt?

Auf den ersten Blick sehe ich auch deshlab keinen Grund warum der Code abhängig von einer Spalte sein sollte, denn egal welche Spalte ihn auslöst, du gibst ja „V“(Y) fest vor.

So, das mußte mal raus, morgen schaue ich mir mal den Code genauer an :smile:)

Gruß
Reinhard

Option Explicit
'
Private Sub Worksheet\_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Bild As Shape, PicName As String, ZellenName As String
For Each Shape In Me.Shapes
 If Shape.Type = msoPicture Then Shape.Delete
Next Shape
For i = 3 To 300
 ZellenName = "V" & i
 PicName = "PicG" & i
 With Range(ZellenName)
 For Each Bild In Sheets("Trend").Shapes
 If Bild.Name = .Text Then
 Bild.Visible = True
 Bild.Copy
 Sheets("ORG").Paste Range(ZellenName)
 Me.Shapes(.Text).Name = PicName
 Me.Shapes(PicName).Left = .Left
 Me.Shapes(PicName).Top = .Top
 End If
 Next Bild
 End With
Next i
For i = 3 To 300
 ZellenName = "Y" & i
 PicName = "PicG" & i
 With Range(ZellenName)
 For Each Bild In Sheets("Trend").Shapes
 If Bild.Name = .Text Then
 Bild.Visible = True
 Bild.Copy
 Sheets("ORG").Paste Range(ZellenName)
 Me.Shapes(.Text).Name = PicName
 Me.Shapes(PicName).Left = .Left
 Me.Shapes(PicName).Top = .Top
 End If
 Next Bild
 End With
Next i
Application.ScreenUpdating = True
End Sub
#6

OT Naja, wieder was für die Tonne
Hallo,

damit meinte ich jetzt nicht Elkes Figur, kenne sie ja nicht.

Ich meine etwas Andreas, ist zwar übelst pauschal *schäm*, aber auch Erfahrenswert *leider*, auch in anderen Foren,
erstens ist es meist angebracht bei Neumitgliedern die erst paar Tage da sind und eine Anfrage stellen, einfach erstmal zurückzufragen, meist gibt es da sowieso genug Ungeklärtes da unerfahren, weil ja neu im Brett.

(wegen dem pauschal, auch bei von der Vika her Stammmitgliedern, sollte man gelegentlich erst mal irgendwas rückfragen um zu testen ob da überhaupt noch Interesse an DEREN Anfrage besteht)

Zweitens, wenn dann nix kommt, abhaken das Ganze.
Wenn was kommt, ja, dann kann man sich das Ganze nochmal durchlesen und Lösungen suchen, aber erst ab dann, vorher ist es verlorene Zeit.

Okay, ich weiß das alles, warum habe ich trotzdem sinnlose Zeit …:frowning:

Egal, der/die Nächste kommt frisch, stellt eine Anfrage, wartet die Lösung ab, und bedankt sich sogar, das rückt vieles wieder gerade :smile:

Gruß
Reinhard