Hallo zusammen,
ich soll für meine Firma ein kleines Makro schreiben, dass per Knopfdruck Bilder und Variablen ersetzen soll. Ich habe es soweit geschafft, dass er die Bilder ersetzt und die Variablen ebenfalls.
Es sind mehrere Wertebereiche vorgegeben z.b. von 0 bis 1500, von 1500 bis 2200 usw. mit den dazugehörigen Bildern z.b. für 0 bis 1500 Bild1, für 1500 bis 2200 Bild2 usw.
Wie oben beschrieben wird das Bild1 gelöscht und druch Bild2 ersetzt, sobald der Wert über 1500 geht, aber sobald ich den Wert ein zweites mal über 1500 setze, zeigt er mir an, dass das angegebene Element nicht gefunden wurde in diesem Fall Bild2.
Zurzeit ist mein Code so aufgebaut, dass er nur zwischen dem Wertebereich 0 bis 1500 Bild1 einfügt und von 1500 bis 2200 Bild2.
Die Bilder sind in Tabelle2 abgespeichert und ich arbeite in Tabelle4!
Hier mein Code:
Sub berechnung_punto()
Application.ScreenUpdating = False
'der eingegeben Wert in Zelle F47 wird in der Var breite_1 gespeichert
Dim breite_1 As String
breite_1 = Tabelle4.Range("F47").Value
dicke26 = "2x6"
dicke28 = "2x8"
dicke210 = "2x10"
'Wenn breite_1 größer als 1500 und dicke26 gleich 2x6 entspricht,dann
If breite_1 > 1500 And dicke26 = "2x6" Then
'Das Bild der aktiven Tabelle (<b>Bild1</b>) auswählen
ActiveSheet.Shapes.Range(Array("Halter_2")).Select
'Die Selektion löschen
Selection.Delete
'Tabelle 2 auswählen
Sheets("Tabelle2").Select
'Das Bild der aktiven Tabelle (<b>Bild2</b>) auswählen
ActiveSheet.Shapes.Range(Array("Halter_3")).Select
'Selektion kopieren
Selection.Copy
'Tabelle "Punto" auswählen
Sheets("Punto").Select
'Zelle E19 auswählen
Range("E19").Select
'Ins aktive Blatt einfügen
ActiveSheet.Paste
'Die Selektion Platzieren
Selection.ShapeRange.IncrementLeft -230.4545669291
Selection.ShapeRange.IncrementTop -175.0908661417
Selection.ShapeRange.IncrementLeft 1.3637007874
Selection.ShapeRange.IncrementTop 13.6363779528
Ich habe es mit einer Schleife versucht aber die hat auch nicht funktioniert.
Schleife:
Do While breite_1 > 1500 And breite_1 < 2200
If breite_1 > 1500 And dicke26 = "2x6" Then
ActiveSheet.Shapes.Range(Array("Halter_3")) = True
End If
Loop
Meine Frage ist wie ich die Bilder per Schleife auswählen kann und kopieren und ersetzen und gleichzeitig überprüfen kann, ob Bild1 bei einem eingegebenen Wert zwischen 0 bis 1500 vorhanden ist, wenn ja dann soll er nichts machen, wenn nein kopieren und einfügen.
Ich bedanke mich schon einmal im Voraus.
Beste Grüße
Daniel