hi all...
i need help how to extract picture then automatically placing and resize onto box..
start box in row 84 to 87..
please, check this file..
any help, much appreciated...
john m
hi all...
i need help how to extract picture then automatically placing and resize onto box..
start box in row 84 to 87..
please, check this file..
any help, much appreciated...
john m
i think this new file make clear...
i have extract/insert picture 4 pic from a folder in cell
then i want 4 pic can automatically resize and placed in cell star row from 84 to 87 (4 box cell)
my arrow i hope can be explain..
how to make it using vba/macro
This will work for you example. But to make it more generally useful you may need a better way of identify the pictures to be moved.Sub Test() Dim pic As Shape Dim cellFrames As Variant Dim index As Long index = 9 For Each cellFrames In Range("$F$84:$M$87,$O$84:$V$87,$X$84:$AD$87,$AG$84:$AM$87").Areas Set pic = ActiveSheet.Shapes("Picture " & index) pic.Height = cellFrames.Height pic.Left = cellFrames.Left + ((cellFrames.Width - pic.Width) / 2) pic.Top = cellFrames.Top index = index + 1 Next End Sub
hi andy...
after i change that picture with the new picture in different cell..
that code not work...
showing system error - the parameter is incorrect....how to code keep running wherever that picture place
how to fixed?
note :
i pull picture from excel Menu Insert, Picture browse picture...
Last edited by Jhon Mustofa; 09-30-2017 at 12:35 PM.
As I said you need a more positive way to identify the pictures to be used.
You might be able to use the picture collection and ignore the existing pictures used for logos at the top of the sheet.
Perhaps a better way would be to load pictures on to a spare sheet firstSub Test() Dim pic As Object Dim cellFrames As Variant Dim index As Long index = 4 ' ignore first 3 pictures For Each cellFrames In Range("$F$84:$M$87,$O$84:$V$87,$X$84:$AD$87,$AG$84:$AM$87").Areas Set pic = ActiveSheet.Pictures(index) pic.Height = cellFrames.Height pic.Left = cellFrames.Left + ((cellFrames.Width - pic.Width) / 2) pic.Top = cellFrames.Top index = index + 1 Next End Sub
Sub Test() Dim pic As Shape Dim picSource As Worksheet Dim cellFrames As Variant Dim index As Long Set picSource = Worksheets("SHeet1") index = 1 For Each cellFrames In Range("$F$84:$M$87,$O$84:$V$87,$X$84:$AD$87,$AG$84:$AM$87").Areas Set pic = picSource.Shapes(index) pic.Copy ActiveSheet.Paste With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) .Height = cellFrames.Height .Left = cellFrames.Left + ((cellFrames.Width - .Width) / 2) .Top = cellFrames.Top End With index = index + 1 Next Do While picSource.Shapes.Count > 0 picSource.Shapes(1).Delete Loop End Sub
thank you very much Andy...it's help me..
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks