Grafiken, Schleife?, kein "range" u. "select"

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Grafiken, Schleife?, kein "range" u. "select"
von: AndreasS
Geschrieben am: 11.12.2003 13:17:55

Hallo!

Mein Problem:
Habe eine Spalte(K9:55) in die Werte eingetragen werden. Wird ein Wert überschritten (aus Spalte I oder J) wird eine Grafik nach Abschluss der Eingabe per Button eingefügt.
Kann man auch per Schleife prüfen? Außerdem würde ich gerne das ganze "select" und "range" eliminieren.
Zudem funktioniert die nummerische Prüfung nicht ganz...
Der Code ist irrsinnig lang und unübersichtlich...

Codeauszug:
If Not IsNumeric(ActiveSheet.Range("K9")) Then
MsgBox "Bitte eine Zahl eingeben..."
ElseIf ActiveSheet.Range("K9") <> "" Then
If ActiveSheet.Range("K9").Value < ActiveSheet.Range("I9").Value Then
Range("L9").Select
ActiveSheet.Pictures.Insert("G:\...\achtung.bmp").Select
End If

If ActiveSheet.Range("K9").Value > ActiveSheet.Range("J9").Value Then
Range("L9").Select
ActiveSheet.Pictures.Insert("G:\...\achtung.bmp").Select
End If
End If

Hier eine weitere Spalte (P) in die Grafiken eingefügt werden:
Der Wert (in Spalte O) ist immer gleich (vielleicht hier Schleife?!)

Codeauszug:
If Not IsNumeric(ActiveSheet.Range("O9")) Then
MsgBox "Bitte eine Zahl eingeben..."
ElseIf ActiveSheet.Range("O9") <> "" Then
If ActiveSheet.Range("O9").Value > 20 Then
Range("P9").Select
ActiveSheet.Pictures.Insert("G:\...\achtung.bmp").Select
End If
End If

Im vor raus Danke an alle die sich mit meinem Problem befassen.
Für jede Anregung oder Hilfe bin ich dankbar

Gruß

Andreas

Bild


Betrifft: AW: Grafiken, Schleife?, kein "range" u. "select"
von: Hallo, hier einige Vorschlage fur Dich :-)
Geschrieben am: 11.12.2003 14:58:38

Option Explicit


Sub PictureInsert()
    Dim rTestZelle As Range
    
    Set rTestZelle = [k9]
    If (IsError(rTestZelle.Value) = True) Then
        MsgBox "Error in der Tets-Zelle " & _
               rTestZelle.Address(rowabsolute:=False, columnabsolute:=False)
               
    ElseIf (IsNumeric(rTestZelle.Value) = False) Then
        MsgBox "Bitte eine Zahl eingeben..."
        
    ElseIf (CStr(rTestZelle.Value) <> "") Then
        
        If rTestZelle.Value < [I9].Value Then
            [L9].Activate
            ActiveSheet.Pictures.Insert ("C:\Temp\pic.bmp")
            
        ElseIf rTestZelle.Value < [J9].Value Then
            [L9].Activate
            ActiveSheet.Pictures.Insert ("C:\Temp\pic2.bmp")
            
        End If
        
    End If
End Sub



Bild


Betrifft: AW: Grafiken, Schleife?, kein "range" u. "select"
von: AndreasS
Geschrieben am: 11.12.2003 15:13:10

Hallo,
danke für die Meldung. Funktioniert einwandfrei.
Hast du vielleicht noch ne Idee bezüglich einer Schleife, in einer Spalte, wenn der Wert immer > 20?
Gruß
Andreas


Bild


Betrifft: AW: Grafiken, Schleife?, kein "range" u. "select"
von: Hallo, hier noch einige Vorschlage fur Dich :-)
Geschrieben am: 11.12.2003 15:44:51

Option Explicit

Private Const TESTVALUE% = 20
' es werden die Zellen im Range o9:o15 getestet, ob > TESTVALUE% oder < TESTVALUE%
' und je nach dem ob grosser oder kleiner wird ein bild in die Nachbarzelle zugegeben und dessen Grosse wird der Host-Zelle angepast. Gruss q
' wird
' hier starten
Public Sub PictureInsertInRange()
Dim rTestRange As Range
Dim rZelle As Range

Set rTestRange = [o9:o15]

For Each rZelle In rTestRange.Cells
Call TestAndInsert(rZelle)
Next rZelle
End Sub



Private Sub TestAndInsert(ByVal rPar As Range)
    Dim rTestZelle As Range
    Dim Sh As Object
    
    Set rTestZelle = rPar
    
    If (IsError(rTestZelle.Value) = True) Then
        MsgBox "Error in der Tets-Zelle " & _
               rTestZelle.Address(rowabsolute:=False, columnabsolute:=False)
               
    ElseIf (IsNumeric(rTestZelle.Value) = False) Then
        MsgBox "Bitte eine Zahl eingeben..."
        
    ElseIf (CStr(rTestZelle.Value) <> "") Then
        
        If rTestZelle.Value < TESTVALUE Then
            rTestZelle.Offset(0, 1).Activate
            ActiveSheet.Pictures.Insert("C:\Temp\pic.bmp").Select
            Set Sh = Selection
            With Sh
                .Height = rTestZelle.Height
                .Width = rTestZelle.Offset(0, 1).Width
            End With
        ElseIf rTestZelle.Value > TESTVALUE Then
            rTestZelle.Offset(0, 1).Activate
            ActiveSheet.Pictures.Insert("C:\Temp\pic2.bmp").Select
            Set Sh = Selection
            With Sh
                .Height = rTestZelle.Height
                .Width = rTestZelle.Offset(0, 1).Width
            End With
        End If
        
    End If
End Sub



Bild


Betrifft: AW: Grafiken, Schleife?, kein "range" u. "select"
von: AndreasS
Geschrieben am: 12.12.2003 06:37:56

Cool, danke für die Hilfe. Jetzt siehts schon viel besser aus!


Bild


Betrifft: Range erweitern
von: AndreasS
Geschrieben am: 12.12.2003 07:02:12

Hallo,
bins doch nochmal. Habe noch eine Frage bezüglich "Set rTestRange = [o9:o15]"
aus deinem Code. Wenn ich den Range auf "o9:o57", wie in meiner Tabelle, erweitere,
wird die Überprüfung trotzdem nur bis "o15" durchgeführt!?
Für eine Antwort wäre ich sehr dankbar!
Gruß
Andreas


Bild


Betrifft: War wohl etwas verschlafen! Sorry.
von: AndreasS
Geschrieben am: 12.12.2003 11:21:02

Hallo,
läuft alles, war wohl etwas? verschlafen...
Nochmals Danke.
Gruß
Andreas


Bild

Beiträge aus den Excel-Beispielen zum Thema " mehrere optionsfelder?"