Hallo,
Ich möchte mithilfe von VBA in Excel ein Puzzle basteln, das funktioniert soweit ganz gut, aber ein Problem gibt es noch:
Wenn ein Puzzleteil richtig neben ein weiteres gesetzt wird, soll es quasi ans andere "dranspringen", sozusagen einrasten. Ist das möglich und wenn ja, wie? Vielen Dank schonmal :)
Bisheriger Code:
Sub Fuzzli()
'
' Klasse Puzzle, Motiv von Anne Geddes
'
Dim myShape As Shape
Dim X As Integer
Dim A As Integer
Dim B As Integer
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
For Each myShape In ws.Shapes
If myShape.Type = msoPicture Then myShape.Delete
Next
Next
A = 2
Do Until A = 11
A = A + 1
ActiveWindow.ScrollColumn = A
Loop
B = 2
Do Until B = 7
B = B + 1
ActiveWindow.ScrollRow = 2
Loop
Range("A1").Select
ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\ag2.jpg").Select
Selection.ShapeRange.IncrementLeft 1
Selection.ShapeRange.IncrementTop 200
Do Until X = 10
X = X + 1
ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\b" & X & ".jpg").Select
Selection.ShapeRange.IncrementLeft Int(((6 - 1 + 1) * Rnd + 1) * 100)
Selection.ShapeRange.IncrementTop Int(((6 - 1 + 1) * Rnd + 1) * 40)
Loop
End Sub
|