Hi there,

I am struggling on getting a VBA script to work correctly for a spreadsheet and I am seeking guidance. I am using Excell 2007 Professional and what I am trying to do is create a profile pages for an event at work.

What i'm trying to do is have the profile page set up, and where the picture will go have a box the user can click, once they click the box it will load a window for them to browse their computers directory to find the image, choose the image and say "ok" and it will insert and resize the image to the specified cell size. Once the image is inserted the box would either be covered up or disapear.

Can this be achieved? All I have been able to figure out is the following which will not resize or set destination cell and only allows JPEG's.

Please help! I am new to trying to code VBA projects.

Private Sub CommandButton1_Click()
Dim JPeg()
Dim flname As Variant
flname = Application.GetOpenFilename
If flname < False Then
If Right(flname, 3) = "jpg" Then
ActiveSheet.Pictures.Insert (flname)
Else
MsgBox "That is not a jpeg file"
End If
End If
End Sub

hi,

Private Sub CommandButton1_Click()
Dim fd As FileDialog
Dim ffs As FileDialogFilters
Dim Rng As Range
Set Rng = ActiveSheet.Range("B8") ' adapt to your range
Rng.Select
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
Set ffs = .Filters
With ffs
.Clear
.Add "Pictures", "*.jpg"
End With
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fichier = fd.SelectedItems(1)
Set Pict = ActiveSheet.Pictures.Insert(Fichier)
Pict.ShapeRange.LockAspectRatio = msoFalse
Pict.Height = Rng.Height
Pict.Width = Rng.Width
End With
End Sub

isabelle

Le 2014-07-18 11:06, clvrbas a écrit :
Hi there,

I am struggling on getting a VBA script to work correctly for a
spreadsheet and I am seeking guidance. I am using Excell 2007
Professional and what I am trying to do is create a profile pages for an
event at work.

What i'm trying to do is have the profile page set up, and where the
picture will go have a box the user can click, once they click the box
it will load a window for them to browse their computers directory to
find the image, choose the image and say "ok" and it will insert and
resize the image to the specified cell size. Once the image is inserted
the box would either be covered up or disapear.

Can this be achieved? All I have been able to figure out is the
following which will not resize or set destination cell and only allows
JPEG's.

Please help! I am new to trying to code VBA projects.

Private Sub CommandButton1_Click()
Dim JPeg()
Dim flname As Variant
flname = Application.GetOpenFilename
If flname < False Then
If Right(flname, 3) = "jpg" Then
ActiveSheet.Pictures.Insert (flname)
Else
MsgBox "That is not a jpeg file"
End If
End If
End Sub

This works really great, one problem though; when I protect the sheet it re sizes to normal size and has an error, is there a way around that?

hi,

when you protect the sheet, you have to allow the users to edit objects
(DrawingObjects:=False)

ActiveSheet.Protect "password", DrawingObjects:=False, Contents:=True,
Scenarios:=True

isabelle

Le 2014-07-21 11:58, clvrbas a écrit :

This works really great, one problem though; when I protect the sheet it
re sizes to normal size and has an error, is there a way around that?

Thank you, i should have specified more clearly. I was hoping I could only allow users to edit that particular object, and not the other objects I have on the sheet. I'll insert this and see what I can do! :) Thank you for your help.

-- Chris

hi,

Private Sub CommandButton1_Click()
Dim fd As FileDialog
Dim ffs As FileDialogFilters
Dim Rng As Range

ActiveSheet.UnProtect "password"

Set Rng = ActiveSheet.Range("B8") ' adapt to your range
Rng.Select
Set fd = Application.FileDialog(msoFileDialogOpen)
With fd
Set ffs = .Filters
With ffs
.Clear
.Add "Pictures", "*.jpg"
End With
.AllowMultiSelect = False
If .Show = False Then Exit Sub
Fichier = fd.SelectedItems(1)
Set Pict = ActiveSheet.Pictures.Insert(Fichier)
Pict.ShapeRange.LockAspectRatio = msoFalse
Pict.Height = Rng.Height
Pict.Width = Rng.Width
End With

ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

isabelle

Le 2014-07-21 16:56, clvrbas a écrit :

isabelle;1618222 Wrote:
hi,

when you protect the sheet, you have to allow the users to edit objects

(DrawingObjects:=False)



isabelle

Le 2014-07-21 11:58, clvrbas a écrit :-

This works really great, one problem though; when I protect the sheet
it
re sizes to normal size and has an error, is there a way around that?
-

Thank you, i should have specified more clearly. I was hoping I could
only allow users to edit that particular object, and not the other
objects I have on the sheet. I'll insert this and see what I can do!
:) Thank you for your help.

-- Chris

You are amazing! Thank you for the assistance!!!

Hi There,

I sent this out to test with a peer on another machine, and when sending it back, the picture was not on the sheet. Any advice?

Thank you,

Chris

hi Chris,

if you do not want the text to be modified why not use a Label.

Set shp = ActiveSheet.Shapes.AddLabel(msoTextOrientationHori zontal, 100, 100,
200, 50)

for the font color try with:

With shp
.TextFrame2.TextRange.Characters.Font.Fill.ForeCol or.RGB = RGB(255, 0, 0)

isabelle

Le 2014-07-22 17:22, clvrbas a écrit :
Hello there!

I am trying to insert a text box using VBA. I have been able to get all
components of the text box to work except changing the font color. The
other hurdle i'm struggling with is trying to keep the sheet locked, but
allowing the user to still be able to edit this object only, and not all
the other objects on the sheet. In need of more experienced VBA
writers.

Sub add_textbox_VBA()

Dim shp As Shape
ActiveSheet.Unprotect "password"
Set shp = ActiveSheet.Shapes.AddTextBox(msoTextOrientationHo rizontal,
100, 100, 200, 50) ' add shape
With shp
TextFrame.Characters.Text = "Example" ' add text to display
Top = Range("B2").Top ' adjust top
Left = Range("B2").Left 'adjust left
TextFrame.AutoSize = True ' turn on autosize
TextEffect.FontSize = 16
TextEffect.FontName = "Arial Black"
Fill.ForeColor.RGB = RGB(0, 56, 150) 'choose fill color
Line.Weight = 1 ' adjust width
Line.ForeColor.RGB = RGB(0, 56, 150) ' choose color
Line.DashStyle = msoLineSolid ' choose style
End With

ActiveSheet.Protect "password", DrawingObjects:=False, Contents:=False,
Scenarios:=False
End Sub

i may have misunderstood, maybe that you want the text can be changed even if
the sheet is protected

Set shp = ActiveSheet.Shapes.AddTextBox(msoTextOrientationHo rizontal, 100, 100,
200, 50) ' add shape
With shp
.TextFrame2.TextRange.Characters.Font.Fill.ForeCol or.RGB = RGB(255, 0, 0)
.ControlFormat.LockedText = False

isabelle

Le 2014-07-22 23:13, isabelle a écrit :
hi Chris,

if you do not want the text to be modified why not use a Label.

Set shp = ActiveSheet.Shapes.AddLabel(msoTextOrientationHori zontal, 100, 100,
200, 50)

for the font color try with:

With shp
.TextFrame2.TextRange.Characters.Font.Fill.ForeCol or.RGB = RGB(255, 0, 0)

isabelle

I see what I was doing wrong. I was trying to enter the font fill as a separate line. My final question then I am done bugging you :) is I had a team member fill out the form and insert their image, when I received their file back, the image was broken. Does this script not attach it into the file? What i'm using this for will go out to about 200 people to make their profile page and send back to me for compiling, everyone is using different machines. Any advice?

My workaround is they save as a .PDF then send me that file if it's too complicated.

I truly appreciate your help!

- Chris