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

• Grafiken, Schleife?, kein "range" u. "select" von AndreasS vom 11.12.2003 13:17:55
  • AW: Grafiken, Schleife?, kein "range" u. "select" - von Hallo, hier einige Vorschlage fur Dich :-) am 11.12.2003 14:58:38
    • AW: Grafiken, Schleife?, kein "range" u. "select" - von AndreasS am 11.12.2003 15:13:10
      • AW: Grafiken, Schleife?, kein "range" u. "select" - von Hallo, hier noch einige Vorschlage fur Dich :-) am 11.12.2003 15:44:51
        • AW: Grafiken, Schleife?, kein "range" u. "select" - von AndreasS am 12.12.2003 06:37:56
        • Range erweitern - von AndreasS am 12.12.2003 07:02:12
          • War wohl etwas verschlafen! Sorry. - von AndreasS am 12.12.2003 11:21:02

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

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

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

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

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!

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

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