PDA

View Full Version : [SOLVED:] Move picture in cell to a specified number of cells away, without losing focus



vanhunk
07-31-2024, 06:04 AM
MOVE IN CELL PICTURE A NUMBER OF TIMES, SPECIFIED IN A DIFFERENT CELL, IN A DIRECTION, WITHOUT LOOSING FOCUS WHEN SPECIFIED NUMBER IS CHANGED:

Greetings,

I have an in-cell picture that I want to move around a maze.
I have 4 direction buttons (different macros), one for each direction, i.e., left, right, up, or down.
I have a dedicated cell with a number typed in, indicating the number of cells the picture must move in one of the directions above, determined by the button clicked.

I want to be able to change the number in the dedicated cell, and be able to click on another direction button, without having to click on the picture again.
I.e., I don't want the in-cell picture to lose focus between changing the number in the dedicated cell, and clicking on another direction button.

In my current code, after changing the number in the dedicated cell, I have to click on the in-cell picture again, before I click on one of the direction buttons again.

Current Code:


Sub Left()
' Left Macro


Set StepsStart = ActiveCell

ActiveCell.Copy
ActiveCell.Offset(0, -Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

StepsStart.ClearContents

End Sub
Sub Right()
' Right Macro

Set StepsStart = ActiveCell

ActiveCell.Copy
ActiveCell.Offset(0, Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

StepsStart.ClearContents

End Sub
Sub Up()
' Up Macro
Set StepsStart = ActiveCell

ActiveCell.Copy
ActiveCell.Offset(-Range("Steps").Value, 0).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

StepsStart.ClearContents

End Sub
Sub down()
' Down Macro

Set StepsStart = ActiveCell

ActiveCell.Copy
ActiveCell.Offset(Range("Steps").Value, 0).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

StepsStart.ClearContents

End Sub


See attached spreadsheet for clarity.

I did not manage to change or add code to achieve the desired result, your help and time is much appreciated.

Thank you

Regards
vanhunk

Jan Karel Pieterse
07-31-2024, 07:43 AM
Here is a start. I've named the cell with the Bee 'Bee'.

Sub Left()
' Left Macro


Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(0, -Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

End Sub
Sub Right()
' Right Macro

Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(0, Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

End Sub
Sub Up()
' Up Macro
Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(-Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents
End Sub
Sub down()
' Down Macro

Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(Range("Steps").Value).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

End Sub

vanhunk
08-01-2024, 02:01 AM
@Jan Karel Pieterse

Thank you so much Jan, it is perfect. I made a few changes to prevent the blue block from being affected when the Bee accidentally land on them and I add reset code to take the Bee back to its starting position.

See code below:


Sub Left()
' Left Macro


Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(0, -Range("Steps").Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
End Sub
Sub Right()
' Right Macro

Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(0, Range("Steps").Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

End Sub
Sub Up()
' Up Macro
Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(-Range("Steps").Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents
End Sub
Sub down()
' Down Macro

Set StepsStart = Range("Bee")

StepsStart.Copy
StepsStart.Offset(Range("Steps").Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Name = "Bee"
StepsStart.ClearContents

End Sub
Sub ResetToStart()
'Reset Bee to start position

If Not Intersect(Range("D5"), Range("Bee")) Is Nothing Then Exit Sub

Set StepsStart = Range("Bee")

Range("Bee").Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

ActiveCell.Name = "Bee"

StepsStart.ClearContents


End Sub


Best Regards
vanhunk