Bilder ein/ausbelnden WENN Zellenergebniss 1-7

Private Sub Worksheet_Change(ByVal Target As range) If range("AI13").Value = 1 Then ActiveSheet.Pictures("Bild 1").Visible = True Else ActiveSheet.Pictures("Bild 1").Visible = False End If If range("AI13").Value = 2 Then ActiveSheet.Pictures("Bild 2").Visible = True Else ActiveSheet.Pictures("Bild 2").Visible = False End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer If Not Application.Intersect(Target, Range("AI13")) Is Nothing Then For i = 1 To 7 Worksheets("Maße+Gewicht VQC2000").Pictures("Bild " & i).Visible = Target = i Next i End If End Sub

Private Sub Worksheet_Change(ByVal Target As range) ' Wenn AI13=7 (Multipolstecker) dann Macro LöscheEinAus If Target.Count = 1 Then If Target.Address = "$AI$13" And Target.Value = 7 Then Application.EnableEvents = False Call LöscheEinAusModule Application.EnableEvents = True End If ' erstellt von Hajo.Ziplies@web.de 16.08.03 ' alle Buchstaben Groß in einem bestimmten Bereich Dim RaBereich As range, RaZelle As range Application.EnableEvents = False ' Bereich der Wirksamkeit Set RaBereich = range("AO13:BM13") ' ActiveSheet.Unprotect Application.EnableEvents = False For Each RaZelle In range(Target.Address) If Not Intersect(RaZelle, RaBereich) Is Nothing Then RaZelle.Value = UCase(RaZelle.Value) End If Next RaZelle Application.EnableEvents = True ' ActiveSheet.protect Set RaBereich = Nothing End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) ' Wenn AI13=7 (Multipolstecker) dann Macro LöscheEinAus Dim i As Integer Dim RaBereich As Range On Error GoTo ERRHANDLER Application.EnableEvents = False Set RaBereich = Range("AO13:BM13") 'Bereich für Großschreibung If Target.Count = 1 Then If Target.Address = "$AI$13" And Target.Value = 7 Then Call LöscheEinAusModule 'was macht das? End If ' erstellt von Hajo.Ziplies@web.de 16.08.03 ' alle Buchstaben Groß in einem bestimmten Bereich ' ActiveSheet.Unprotect If Not Intersect(Target, RaBereich) Is Nothing Then Target.Value = UCase(Target.Value) End If ' ActiveSheet.protect If Not Application.Intersect(Target, Range("AI13")) Is Nothing Then For i = 1 To 7 Worksheets("Maße+Gewicht VQC2000").Pictures("Bild " & i).Visible = Target = i Next i End If End If ERRHANDLER: Set RaBereich = Nothing Application.EnableEvents = True End Sub

Sub LöscheEinAusModule() ' LöscheEinAusModule Makro ' Makro aufgezeichnet range("H13:I13").Select ActiveCell.FormulaR1C1 = "0" range("K13:L13").Select ActiveCell.FormulaR1C1 = "0" range("N13:O13").Select ActiveCell.FormulaR1C1 = "0" range("Q13:R13").Select ActiveCell.FormulaR1C1 = "0" range("T13:U13").Select ActiveCell.FormulaR1C1 = "0" range("W13:X13").Select ActiveCell.FormulaR1C1 = "0" range("Z13:AA13").Select ActiveCell.FormulaR1C1 = "0" range("AC13:AD13").Select ActiveCell.FormulaR1C1 = "0" range("AI13:AJ13").Select End Sub

Private Sub Worksheet_Change(ByVal Target As Range) ' Wenn AI13=7 (Multipolstecker) dann Macro LöscheEinAus Dim i As Integer Dim RaBereich As Range On Error GoTo ERRHANDLER Application.EnableEvents = False Set RaBereich = Range("AO13:BM13") 'Bereich für Großschreibung If Target.Count = 1 Then If Target.Address = "$AI$13" Then For i = 1 To 7 Worksheets("Maße+Gewicht VQC2000").Pictures("Bild " & i).Visible = Target = i Next i If Target.Value = 7 Then For i = 8 To 29 Step 3 Range(Cells(13, i), Cells(13, i + 1)) = 0 Next i End If If Not Intersect(Target, RaBereich) Is Nothing Then Target.Value = UCase(Target.Value) End If End If ERRHANDLER: Set RaBereich = Nothing Application.EnableEvents = True End Sub

Hallo Rudi,
sorry die Antwort hat ein bischen gedauert.
Habe nochmal getetster: ?application.enableevents > WAHR 8code läuft!
Allerdings sind auf Maße+Gewicht VQC2000 alle bilder zusehen.
Desweiteren geht die Funktion - automatisch alle Buchstaben gross - sowie das Löschmacro nicht mehr.
Also im summar summarum geht nicht !
Ich versteh nicht woran es liegen kann.
Kann man es evtl. auf dieser basis realisieren ?


Private Sub Worksheet_Change(ByVal Target As range)
'If range("BB1").Value = 1 Then
'ActiveSheet.Pictures("Bild 1").Visible = True
'Else
'ActiveSheet.Pictures("Bild 1").Visible = False
'End If
If range("BB1").Value = "2" Then
ActiveSheet.Pictures("Bild 2").Visible = True
Else
ActiveSheet.Pictures("Bild 2").Visible = False
End If
If range("BB1").Value = 3 Then
ActiveSheet.Pictures("Bild 3").Visible = True
Else
ActiveSheet.Pictures("Bild 3").Visible = False
End If
'If range("BB1").Value = 4 Then
'ActiveSheet.Pictures("Bild 4").Visible = True
'Else
'ActiveSheet.Pictures("Bild 4").Visible = False
'    End If
If range("BB1").Value = 5 Then
ActiveSheet.Pictures("Bild 5").Visible = True
Else
ActiveSheet.Pictures("Bild 5").Visible = False
End If
If range("BB1").Value = 6 Then
ActiveSheet.Pictures("Bild 6").Visible = True
Else
ActiveSheet.Pictures("Bild 6").Visible = False
End If
'If range("BB1").Value = 7 Then
'ActiveSheet.Pictures("Bild 7").Visible = True
'Else
'ActiveSheet.Pictures("Bild 7").Visible = False
'    End If
End Sub

Gruss
Ralph

Beliebteste Forumthreads (12 Monate)

Bilder ein/ausbelnden WENN Zellenergebniss 1-7

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bilder ein/ausbelnden WENN Zellenergebniss 1-7

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread