Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 20
Default Insert Picture

I am using the following Macro to insert a picture into a protected sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in tools -
protection - sheet protect prior to Password Protecting again?
  #2   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 10,593
Default Insert Picture

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in tools -
protection - sheet protect prior to Password Protecting again?



  #3   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 20
Default Insert Picture

Thanks Bob. That works great.

Is there any way that the picture can be centred vertically in the range of
cells instead of at the top?

"Bob Phillips" wrote:

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in tools -
protection - sheet protect prior to Password Protecting again?




  #4   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 10,593
Default Insert Picture

Try this, It centres vertically and horizontally in case it scales long as
against wide.

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double
Dim nWidth As Double
Dim nHeight As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
nWidth = myPict.Width / nScale
nHeight = myPict.Height / nScale
myPict.Width = nWidth
myPict.Height = nHeight
myPict.Top = (.Height - nHeight) / 2
myPict.Left = (.Width - nWidth) / 2
End With
.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Thanks Bob. That works great.

Is there any way that the picture can be centred vertically in the range
of
cells instead of at the top?

"Bob Phillips" wrote:

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected
sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep
its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in tools -
protection - sheet protect prior to Password Protecting again?






  #5   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 20
Default Insert Picture

Hi Bob,

Thanks for your help on this macro

I tried it. For some reason it moves the picture directly above and outside
of the preset (a1:b9) range

"Bob Phillips" wrote:

Try this, It centres vertically and horizontally in case it scales long as
against wide.

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double
Dim nWidth As Double
Dim nHeight As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files, *.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
nWidth = myPict.Width / nScale
nHeight = myPict.Height / nScale
myPict.Width = nWidth
myPict.Height = nHeight
myPict.Top = (.Height - nHeight) / 2
myPict.Left = (.Width - nWidth) / 2
End With
.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Thanks Bob. That works great.

Is there any way that the picture can be centred vertically in the range
of
cells instead of at the top?

"Bob Phillips" wrote:

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected
sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep
its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in tools -
protection - sheet protect prior to Password Protecting again?








  #6   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 10,593
Default Insert Picture

Really, it worked for me. Just tried it again and works every time.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Hi Bob,

Thanks for your help on this macro

I tried it. For some reason it moves the picture directly above and
outside
of the preset (a1:b9) range

"Bob Phillips" wrote:

Try this, It centres vertically and horizontally in case it scales long
as
against wide.

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double
Dim nWidth As Double
Dim nHeight As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
nWidth = myPict.Width / nScale
nHeight = myPict.Height / nScale
myPict.Width = nWidth
myPict.Height = nHeight
myPict.Top = (.Height - nHeight) / 2
myPict.Left = (.Width - nWidth) / 2
End With
.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Thanks Bob. That works great.

Is there any way that the picture can be centred vertically in the
range
of
cells instead of at the top?

"Bob Phillips" wrote:

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh,
nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected
sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep
its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in
tools -
protection - sheet protect prior to Password Protecting again?








  #7   Report Post  
Posted to microsoft.public.excel.newusers
external usenet poster
 
Posts: 20
Default Insert Picture

It must be the way I have the sheet set up. I will have to check it over to
see what I have done. Thanks for your help

"Bob Phillips" wrote:

Really, it worked for me. Just tried it again and works every time.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Hi Bob,

Thanks for your help on this macro

I tried it. For some reason it moves the picture directly above and
outside
of the preset (a1:b9) range

"Bob Phillips" wrote:

Try this, It centres vertically and horizontally in case it scales long
as
against wide.

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double
Dim nWidth As Double
Dim nHeight As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh, nScaleWide)
nWidth = myPict.Width / nScale
nHeight = myPict.Height / nScale
myPict.Width = nWidth
myPict.Height = nHeight
myPict.Top = (.Height - nHeight) / 2
myPict.Left = (.Width - nWidth) / 2
End With
.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
Thanks Bob. That works great.

Is there any way that the picture can be centred vertically in the
range
of
cells instead of at the top?

"Bob Phillips" wrote:

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet
Dim nScaleWide As Double
Dim nScaleHigh As Double
Dim nScale As Double

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
nScaleWide = myPict.Width / .Width
nScaleHigh = myPict.Height / .Height
nScale = IIf(nScaleWide < nScaleHigh, nScaleHigh,
nScaleWide)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = myPict.Width / nScale
myPict.Height = myPict.Height / nScale
End With
'.Protect Password:="hi"
End With

End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"I think I need to rephrase the question"
osoft.com wrote in
message ...
I am using the following Macro to insert a picture into a protected
sheet

Sub testme()
Dim myPictName As Variant
Dim myPict As Picture
Dim wks As Worksheet

Set wks = Worksheets("sheet1")

myPictName _
= Application.GetOpenFilename("Picture files,
*.bmp;*.jpg;*.gif")
If myPictName = False Then
MsgBox "try later!"
Exit Sub
End If

With wks
.Unprotect Password:="hi"
With .Range("a1:B9")
Set myPict = .Parent.Pictures.Insert(myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
End With
.Protect Password:="hi"
End With

End Sub

The macro resizes a picture to fit the cell range

Is it possible to fit a picture into the cell range and keep its
proportions? (ie make it fit into the cell range and relatively keep
its
normal height and width)

Additionally, can you tell the macro to enable "Edit Object" in
tools -
protection - sheet protect prior to Password Protecting again?









Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
how do I insert picture into cell so vlookup can return picture? ah Excel Worksheet Functions 1 May 1st 07 04:38 AM
insert a picture in to a comment but picture not save on hard disk Pablo Excel Discussion (Misc queries) 0 February 21st 07 04:48 PM
Insert Picture maximus73 Excel Discussion (Misc queries) 1 March 16th 06 01:16 AM
How to insert a picture Vance Porfirio Excel Discussion (Misc queries) 0 January 3rd 06 06:52 PM
insert picture BillGwyer Excel Discussion (Misc queries) 1 March 4th 05 07:37 PM


All times are GMT +1. The time now is 10:46 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"