Anweisung beenden und neue starten

Hallo Leute,

folgendes Problem:

Habe ein Bild in einer Excel Tabelle und will nun das es sich bei Klick vergrößert bzw. verkleinert nach dieser Prozedur:

Sub Bild2_BeiKlick()
'
' Bild2_BeiKlick Makro
' Makro am 09.08.2006 von Horst Dieter aufgezeichnet
'

'

ActiveSheet.Shapes("Picture 2").Select
Selection.ShapeRange.ScaleWidth 0.4, msoTrue, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.4, msoTrue, msoScaleFromTopLeft
ActiveSheet.Shapes("Picture 3").Select

End

Selection.ShapeRange.ScaleWidth 0.11, msoTrue, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.11, msoTrue, msoScaleFromTopLeft
ActiveSheet.Shapes("Picture 3").Select

End Sub

Jede Anweisung soll mit einem Mouseclick ausgelöst werden. Nach der ersten Anweisung steht ein End sonst würde die zweite Anweisung ja gleich mit ausgelöst werden.

Aber wie bekomme ich das hin das nach einem zweiten Klick dann die Zweite Anwendung ausgelöst wird?

Ich brauche nur eine Anweisung damit die zweite Anwendung mit einem zweiten Mouseclick ausgeführt wird: Das verkleinern des Bildes

Ich hoffe ihr versteht mich da

Danke schon mal für eure Hilfe

 

Hi

Bei diesem Beispiel geht's:

Sub Makro1()
'
' Makro1 Makro
' Makro am 10.08.2006 von gj aufgezeichnet
'

'

ActiveSheet.Shapes("Picture 1").Select
a = Selection.ShapeRange.Width
If a < 30 Then
Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
Else
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
End If
ActiveSheet.Cells(1, 1).Select
End Sub

HTH
G.

 

Wow das funktioniert super.

Danke erstmal für deine Hilfe.

Aber sobald ich den Scale Wert ändere, weil ich das bild ja größer als 2 machen will, macht er komische Sachen mit dem Bild.

Kannst du da nochma bitte gucken?


Sub Bild2_BeiKlick()
'
' Bild3_BeiKlick Makro
' Makro am 11.08.2006 von Studio FMB GmbH aufgezeichnet
'

'
ActiveSheet.Shapes("Picture 2").Select
a = Selection.ShapeRange.Width
If a < 30 Then
Selection.ShapeRange.ScaleWidth 20.33, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 20.33, msoFalse, msoScaleFromTopLeft
Else

Selection.ShapeRange.ScaleWidth 0.12, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.12, msoFalse, msoScaleFromTopLeft
End If

ActiveSheet.Cells(1, 1).Select


Danke,

 

Hi

der Wert für a sollte knapp oberhalb der realen Width liegen.
( Makro schrittweise abarbeiten und a anzeigen lassen )

Die Faktoren sollten reziproke Werte haben, um ein hin- und herskalieren zu ermöglichen:
2 - 0.5
4 - 0.25
20 - 0.05

Sonst gibts u.U. die seltsamsten Effekte

HTH
G.

 

Und gibt es eine Möglichkeit das Bild größer zu machen?

 

Also das mit dem Bild Größer machen habe ich geschafft, einfach unmittelbar verdoppeln, sieht dann so aus:

Sub Bild8_BeiKlick()
'
' Bild8_BeiKlick Makro
' Makro am 14.08.2006 von ---------------- aufgezeichnet
'

'
ActiveSheet.Shapes("Picture 8").Select
a = Selection.ShapeRange.Width
If a < 30 Then
Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Else
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft

End If
ActiveSheet.Cells(1, 1).Select
End Sub


Trotzdem Danke für die Hilfe.

 

Nun würde ich gerne noch wissen ob wenn man ein Bild einfügt, das dies dann automatisch einem Makro zugewiesen wird ohne das man noch etwas machen muss?