Herbers Excel-Forum - das Archiv
Grafiken, Schleife?, kein "range" u. "select"

|
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