Reset/move different pictures to a specific cells

C

codyssey

New Member
Joined
Oct 15, 2015
Messages
39
Hi everyone

I am trying to make a sheet that has 6 different "markers" (.png images) across the top row (see pic). Each marker is in it's own cell, and are the same size of the cell they cover (102px X 102px). There are 10 copies of each marker stacked on top of each other so that the user can drag multiple markers of the same kind to the user's desired location on a diagram below the top row.

What I am trying to do is this: When the user clicks a reset button, all markers go back into their original cell location, and if any markers were resized by the user they should revert to their original size. (or, make the markers so they cannot be resized. Current code and picture example below. Thank you for your help!

Code: 
Private Sub DrawResetButton_Click()
        ' Move picture to a given cell
        With Sheet3
            With .Range("B2")
                T = .Top
                L = .Left
            End With
            With .Shapes.Item("dome", "dome2") 'this is not working. I cannot figure out how 
                .Top = T                  'to make this apply to two different images, let alone another 
                .Left = L                  'image set (to a different location.
            End With
        End With
End Sub

8rstYPP.png
 
Sort by date Sort by votes
OK, this morning I got the code working to reset the images. It might be sort of inefficient, but it works:

Code: 
Private Sub DrawResetButton_Click()
        ' Move picture to a given cell
        With Sheet3
            With .Range("B2")
                T = .Top
                L = .Left
            End With
            With .Range("C2")
                T2 = .Top
                L2 = .Left
            End With
            
            '==================================
            'MOVE 5" DOME
            '==================================
            
            
            With .Shapes.Item("dome")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome2")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome3")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome4")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome5")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome6")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome7")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome8")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome9")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome10")
                .Top = T
                .Left = L
            End With
            
            '====================================
            'MOVE 8" DOME
            '====================================
            
            With .Shapes.Item("8dome")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome2")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome3")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome4")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome5")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome6")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome7")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome8")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome9")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome10")
                .Top = T2
                .Left = L2
            End With
            
            
        End With
End Sub

Now I am going to try and find a way to get the aspect ratios reset when the button is clicked.
 
Upvote 0
codyssey said:
OK, this morning I got the code working to reset the images. It might be sort of inefficient, but it works:

Code: 
Private Sub DrawResetButton_Click()
        ' Move picture to a given cell
        With Sheet3
            With .Range("B2")
                T = .Top
                L = .Left
            End With
            With .Range("C2")
                T2 = .Top
                L2 = .Left
            End With
            
            '==================================
            'MOVE 5" DOME
            '==================================
            
            
            With .Shapes.Item("dome")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome2")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome3")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome4")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome5")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome6")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome7")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome8")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome9")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome10")
                .Top = T
                .Left = L
            End With
            
            '====================================
            'MOVE 8" DOME
            '====================================
            
            With .Shapes.Item("8dome")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome2")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome3")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome4")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome5")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome6")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome7")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome8")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome9")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome10")
                .Top = T2
                .Left = L2
            End With
            
            
        End With
End Sub

Now I am going to try and find a way to get the aspect ratios reset when the button is clicked.
Click to expand...


codyssey,
This will shorten your code some:

for the 5" DOME:
Note that you still need the top WITH statement:
for the 5" dome:
Code: 
            With .Shapes.Item("dome")
                .Top = T
                .Left = L
            End With

       For siz = 2 to 10
            With .Shapes.Item("dome" & siz)
                .Top = T2
                .Left = L2
            End With
       next siz
So you can remove the following:
Code: 
            With .Shapes.Item("dome2")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome3")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome4")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome5")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome6")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome7")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome8")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome9")
                .Top = T
                .Left = L
            End With
            With .Shapes.Item("dome10")
                .Top = T
                .Left = L
            End With

Likewise with for the 8" DOME:

Code: 
            With .Shapes.Item("8dome")
                .Top = T
                .Left = L
            End With

       For siz = 2 to 10
            With .Shapes.Item("8dome" & siz)
                .Top = T2
                .Left = L2
            End With
       next siz

And remove:
Code: 
            With .Shapes.Item("8dome2")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome3")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome4")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome5")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome6")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome7")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome8")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome9")
                .Top = T2
                .Left = L2
            End With
            With .Shapes.Item("8dome10")
                .Top = T2
                .Left = L2
            End With

Then to get the aspect ratios reset:
I found the code below some time back...it should help.
Perpa

"Reset Size of pasted thumbnails"
Information has been pasted into a worksheet and column 2 contains thumbnail images whose default size is 1.96cm x 1.43cm.
The problem is that the aspect ratio of some of these thumbnails has been distorted due to the sizing of adjacent pasted columns.
To restore all images to their original ratio H/W use the following:
Code: 
Option Explicit
Sub ResetImagesToOriginalSize()
Dim oShape As Shape
   For Each oShape In ActiveSheet.Shapes
       If oShape.Type = msoPicture Then
          oShape.ScaleWidth 1, msoTrue, msoScaleFromTopLeft
          oShape.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
       End If
   Next
End Sub
 
Upvote 0
So I ran into a bit of a problem, there is one shape that cannot be resized because it is locked. Any way to exclude that shape from the code?
 
Upvote 0
OK, here's what I got. I was using this for every single object:


Code: 
 ActiveSheet.Shapes("door").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door2").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door2").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door3").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door3").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door4").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door4").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door5").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door5").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door6").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door6").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door7").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door7").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door8").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door8").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door9").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door9").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door10").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door10").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door").Rotation = 0
    ActiveSheet.Shapes("door2").Rotation = 0
    ActiveSheet.Shapes("door3").Rotation = 0
    ActiveSheet.Shapes("door4").Rotation = 0
    ActiveSheet.Shapes("door5").Rotation = 0
    ActiveSheet.Shapes("door6").Rotation = 0
    ActiveSheet.Shapes("door7").Rotation = 0
    ActiveSheet.Shapes("door8").Rotation = 0
    ActiveSheet.Shapes("door9").Rotation = 0
    ActiveSheet.Shapes("door10").Rotation = 0


I am hoping I can take the general idea of your code and apply it like so:

Code: 
For siz = 2 To 10
            With .Shapes.Item("door" & siz)
                .ScaleHeight 1#, True, msoScaleFromTopLeft, _
                .ScaleWidth 1#, True, msoScaleFromTopLeft, _
                .Rotation = 0
             End With
       Next siz

But I am getting an error: Invalid or unqualified reference. Any ideas? Thank you for your time.
 
Upvote 0
codyssey said:
OK, here's what I got. I was using this for every single object:


Code: 
 ActiveSheet.Shapes("door").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door2").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door2").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door3").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door3").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door4").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door4").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door5").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door5").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door6").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door6").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door7").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door7").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door8").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door8").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door9").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door9").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door10").ScaleHeight 1#, True, msoScaleFromTopLeft
    ActiveSheet.Shapes("door10").ScaleWidth 1#, True, msoScaleFromTopLeft

    ActiveSheet.Shapes("door").Rotation = 0
    ActiveSheet.Shapes("door2").Rotation = 0
    ActiveSheet.Shapes("door3").Rotation = 0
    ActiveSheet.Shapes("door4").Rotation = 0
    ActiveSheet.Shapes("door5").Rotation = 0
    ActiveSheet.Shapes("door6").Rotation = 0
    ActiveSheet.Shapes("door7").Rotation = 0
    ActiveSheet.Shapes("door8").Rotation = 0
    ActiveSheet.Shapes("door9").Rotation = 0
    ActiveSheet.Shapes("door10").Rotation = 0


I am hoping I can take the general idea of your code and apply it like so:

Code: 
For siz = 2 To 10
            With .Shapes.Item("door" & siz)
                .ScaleHeight 1#, True, msoScaleFromTopLeft, _
                .ScaleWidth 1#, True, msoScaleFromTopLeft, _
                .Rotation = 0
             End With
       Next siz

But I am getting an error: Invalid or unqualified reference. Any ideas? Thank you for your time.
Click to expand...

codyssey,
This is untested so try on a copy of your workbook...
Perpa
Code: 
Option Explicit
Sub ResetImagesToOriginalSize()
Dim oShape As Shape
   For Each oShape In ActiveSheet.Shapes
       If oShape.Name = "door" then goto PASSEM
       If oShape.Name <> {"door2", "door3", "door4", "door5", "door6", "door7", "door8", "door9", "door10"} then goto PASSEM
       If oShape.Type = msoPicture Then
          oShape.ScaleWidth 1, msoTrue, msoScaleFromTopLeft
          oShape.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
          oShape.Rotation = 0
       End If
PASSEM:
   Next
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

bizzyizzy215
  • Question Question
A VBA that inserts an image into the actual cell
Replies
1
Views
339
saboh12617
S
O
  • Solved
VBA - floating photo
Replies
3
Views
669
RoryA
RoryA
S
  • Solved
VBA Code - Remove link to inserted pictures
Replies
5
Views
1K
Domenic
D
J
  • Question Question
Inserting picture into cell via VBA
Replies
2
Views
967
Joek88
J
MrIfOnly
  • Question Question
shapes.onaction in add-in using reference path to macro (Excel VBA)
Replies
8
Views
412
jkpieterse
jkpieterse

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top