ShowPicD Function - Aspect Ratio

gobogirl · Jun 11, 2005

Hi.

I've been using the ShowPicD function, kindly provided here:
http://www.mrexcel.com/board2/viewt...order=asc&highlight=picture+function&start=0

Currently, i am typing a fixed width and height for the pictures to be placed. If either I accidently type in an incorrect ratio of width and height or the pictures are not all the same dimensions, it distorts the original picture and locks the aspect ratio.

Can anyone help me with some code to replace the width and height so that it captures and locks the aspect ratio of the original picture's dimensions first then, from a named cell on the worksheet (say "PicWidth" - this would be pixels or percentage) I can resize the pictures according to it's original dimensions if necessary?

Any help or leads is very appreciated.

Thanks.

PA HS Teacher · Jun 11, 2005

I added optional height and width parameters to Damons showpicd function here. http://www.mrexcel.com/board2/viewtopic.php?t=150265&highlight=

You can now do something like,
=ShowPicD("pic address and name",PicHeight * Percentage, PicWidth * Percentage)

As far as excel to determine the width and height of a picture, not sure.

gobogirl · Jun 11, 2005

Trying to get the pixel value of a Picture

Thanks again!

Doinks! I pasted the formula from the older post and didn't pick up on the iWdith and iHeight.

On this note, do you know how i can put these figures into cells on a separate worksheet to the Storyboard?

On the separate worksheet I put the ShowpicD function so that a cell (named "Orig_Pic") is TRUE (didn't put actual picture in). From this, i would like to extract the value of the iWidth to show in a cell named "Orig_Pic_Width" and height in "Orig_Pic_Height".

I have tried this:
Orig_Pic_Width = IF(Orig_Pic=TRUE,iWidth," - ")

It didn't work.
Do you or anyone else have any suggestions?

Thanks again for your help to-date.

gobogirl · Jun 21, 2005

Replace/Delete Picture

Hi Dan,

I'm wondering if you can help me once more - I'm finding the revised ShowPicD function will not remove the embedded image if, for instance, i change the folder name or any part of the path or filename.

Do you know how i can remove/replace the image - in a simlar fashion to the original ShowPicD function from Damon?

Perhaps this may have something to do with the value returned in the cell:
When picture found = TRUE
When picture NOT found = #VALUE! (obviously supposed to read as "FALSE")

Here's the code. I've renamed it for my workseet as ShowPicStrip:

Code:

Function ShowPicStrip(PicFile As String, Optional iHeight As Integer = 200, Optional iWidth As Integer = 300) As Boolean
'Modified (very slightly) from code posted by Damon Ostrander (modified 6-5-05)
'http://www.mrexcel.com/board2/viewtopic.php?t=104322&postdays=0&postorder=asc&start=0
'Same as ShowPic except deletes previous picture when picfile changes
Dim AC As Range
Static p As Shape
On Error GoTo Done
Set AC = Application.Caller
If p Is Nothing Then
'look for a picture already over cell
For Each p In Worksheets("Stripboard").Shapes
If p.Type = msoLinkedPicture Then
If p.Left >= AC.Left And p.Left < AC.Left + AC.Width Then
If p.Top >= AC.Top And p.Top < AC.Top + AC.Height Then
p.Delete
Exit For
End If
End If
End If
Next p
Else
'p.Delete (currently its deleting all of the other pictues, so I commented it out)
'The false in the statements below makes sure pictures are Not saved with file, only links
End If
Set p = Worksheets("Stripboard").Shapes.AddPicture(PicFile, True, False, AC.Left, AC.Top, iWidth, iHeight)
ShowPicStrip = True
Exit Function
Done:
Set p = Worksheets("Stripboard").Shapes.AddPicture(PicFile, True, False, AC.Left, AC.Top, iWidth, iHeight)
ShowPicStrip = False
End Function

Thanks,
Pat.

PA HS Teacher · Jun 21, 2005

I reread Damon's post, I had forgotten about the dead point issue. I add a helper function as he had indicated. The function was having issues when the picture was deleted because p was neither a picture, nor nothing. (I never realized you could use "nor nothing" in a grammatically correct sentence.

I also added a for next loop, 1 to 2, to make sure the picture behind the current picture was deleted as well, otherwise the pictures pile up on the sheet.

I also added a line that recognizes the sheet from which the function was called. This way you don't wind up with pictures popping up on whatever sheet happens to be active when the function recalculates.

Hope this helps!

Code:

Function ShowPicStrip(PicFile As String, Optional iHeight As Integer = 200, Optional iWidth As Integer = 300) As Boolean
'Modified (very slightly) from code posted by Damon Ostrander (modified 6-5-05)
'http://www.mrexcel.com/board2/viewtopic.php?t=104322&postdays=0&postorder=asc&start=0
'Same as ShowPic except deletes previous picture when picfile changes
Dim AC As Range
Static P As Shape
On Error GoTo Done
Set AC = Application.Caller
If Not (PicExists(P)) Then
'look for a picture already over cell
SheetName = Application.Caller.Parent.Name
For i = 1 To 2 'Delete the top picture, and the picture behind it.
For Each P In Worksheets(SheetName).Shapes
If P.Type = msoLinkedPicture Then
If P.Left >= AC.Left And P.Left < AC.Left + AC.Width Then
If P.Top >= AC.Top And P.Top < AC.Top + AC.Height Then
P.Delete
Exit For
End If
End If
End If
Next P
Next i
Else
'(currently its deleting all of the other pictues, so I commented it out)
'The false in the statements below makes sure pictures are Not saved with file, only links
End If
Set P = Worksheets(SheetName).Shapes.AddPicture(PicFile, True, False, AC.Left, AC.Top, iWidth, iHeight)
ShowPicStrip = True
Exit Function
Done:
Set P = Worksheets(SheetName).Shapes.AddPicture(PicFile, True, False, AC.Left, AC.Top, iWidth, iHeight)
ShowPicStrip = False
End Function

Function PicExists(P As Shape) As Boolean
'Return true if P references an existing shape
Dim ShapeName As String
On Error GoTo NoPic
If P Is Nothing Then GoTo NoPic
ShapeName = P.Name
PicExists = True
NoPic:
PicExists = False
End Function

gobogirl · Jun 21, 2005

Oh Thank you, thank you!!

It is now so excellently and perfectly beautiful!

The reason i renamed the function ShowPicStrip was that I had 2 worksheets using the same function. When i was using the same ShowPicD function on both sheets, the pics for both sheets were popping up on any active worksheet. I thus kept ShowPicD and created ShowPicStrip for the other worksheet. Also previously, the Save was saving the pics to the file and my file size was in excess of 5mb if one worksheet had pics and 9mb if both worksheets had pics.

I've now renamed the function ShowPicE to follow suit from the original.

The new code has fixed ALL these problems and i can now revert to the one function! It's great and has made me very very happy.

Thank you again!

PA HS Teacher · Jun 21, 2005

Glad to help, wish I'd thought of the function first, but really it's Damon's and I just modified it a little.

What are you making a Strip of? I think you said it was some sort of story board? Is this for work, school, fun? just wonding.

gobogirl · Jun 21, 2005

Hi.

The storyboard is for work. I work in animation. I'm not the animator, i handle production.

Worksheet 1 is the Storyboard - layout for client presentation.
Worksheet 2 is the "Stripboard" which will be used to create the shoot schedule.
Worksheet 3 (or a linked workbook - i haven't decided the best scenario yet) will be the "Blue Book" which breaks down every conceivable requirement in every shot to provide to every department as a checklist.
All worksheets require storyboard pictures (the crew are very visual people and relate best to the storyboard frames as a "header" together with the Sc-Fr# - if i give them only text documents, they won't read them and i find we'll be missing something on set when we need it no matter how many times i ask if they've done their tasks).

For the next couple of months, the storyboard will change either by moving storyboard frames or replacing or deleting them completely. Because i can link everything, i will know that all changes are accounted for (always seem to either miss a change on a document when inserting manually or it can take me weeks depending on the amount of storyboard frames).

This particular project is stop motion puppet animation - in essence, it is shot on a set very similarly to live action. However, set up for each shot for a stop motion miniature set can take up to 2 days, so we need to schedule the shoot based on shooting all shots with the same set consecutively, Followed by all shots with the same camera angle and/or special effects rigging, etc...

I will make this "document" into a template for every job. It's just made my job incredibly simpler.

Thanks again AND to Damon Ostrander!

BTW - The function works, as i said before, beautifully - for neatness however, if the picture is not found, it is currently giving #VALUE! instead of FALSE (as per the PicExists Function). It's not imperative but do you have any ideas?

Pat.

JonatMV · Jan 28, 2011

PA HS Teacher said:
I also added a for next loop, 1 to 2, to make sure the picture behind the current picture was deleted as well, otherwise the pictures pile up on the sheet.

Hiya,

This is a great function and I've worked it in to a piece here at work. The only problem is that the additional functionality to stop pictures 'piling up' doesn't seem to work. Every time I change a value in the reference area, a duplicate picture arrives on top.

Also - I'm not that great with VBA, but how does the 2nd function ever return a "PicExists = True" - doesn't the code always run through the "PicExists = False" final line?

Hope you can help

ShowPicD Function - Aspect Ratio

gobogirl

Board Regular

Excel Facts

PA HS Teacher

Well-known Member

gobogirl

Board Regular

gobogirl

Board Regular

PA HS Teacher

Well-known Member

gobogirl

Board Regular

PA HS Teacher

Well-known Member

gobogirl

Board Regular

JonatMV

New Member

Similar threads

Forum statistics

Share this page

ShowPicD Function - Aspect Ratio

Board Regular

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock