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

I have the following Macro which I use to insert pictures in Excel 2010 that worked fine but now I have converted the file to Excel 2013 and I am have 2 issues.

1) The macro seems that is not inserting the picture but the link to file, I need to insert the picture straight to the file.

2) The macro is looking in cells that have picture names & when there are not picture names in a cell its suppose to not insert anything, inserted it's inserting a default picture which is only to be inserted when there is a file name but no picture for it.

Appreciate any help, Thanks.


Sub add_pictures()

Const PictureHeight = 120

Folder = "o:\merchgrp\merch images\base images\"
FName = "No_Photo_Available.jpg"
DefaultPicture = Folder & FName

ActiveSheet.Unprotect Password:="12345"
Application.ScreenUpdating = False

'delete pictures
ActiveSheet.Pictures.Delete

LastCol = Cells(7, Columns.Count).End(xlToLeft).Row
Rows(18).RowHeight = PictureHeight

For Each cell In Range("B7:BCK7")
If cell < "" Then
cell.Offset(-6, 0).ClearContents
PictureFound = Dir(cell.Value)
Set Pict = Nothing '<= added
If PictureFound < "" Then

Set Pict = ActiveSheet.Pictures. _
Insert(cell.Value)
Else
On Error Resume Next '<=added
Set Pict = ActiveSheet.Pictures. _
Insert(DefaultPicture)
On Error GoTo 0 '<=added
End If
If Pict Is Nothing Then '<=added
MsgBox ("Could not add picture : " & cell.Value)
Else
Pict.ShapeRange.LockAspectRatio = msoTrue
Pict.ShapeRange.Height = PictureHeight
PictWidth = Pict.Width
CellWidth = Cells(18, cell.Column).Width
WidthBorder = CellWidth - PictWidth
Pict.Left = Cells(18, cell.Column).Left + (WidthBorder / -8)


PictHeight = Pict.Height
CellHeight = Cells(18, cell.Column).Height
HeightBorder = CellHeight - PictHeight
Pict.Top = Cells(18, cell.Column).Top + 4


If Pict.Width Pict.Height Then
If Pict.Width CellWidth Then
Crop = (Pict.Width - CellWidth) / 8
Pict.ShapeRange.PictureFormat.CropLeft = Crop
Pict.ShapeRange.PictureFormat.CropRight = Crop
End If

Else
If CellHeight Pict.Height Then
Crop = Abs(Pict.Height - CellHeight) / 2
Pict.ShapeRange.PictureFormat.CropTop = Crop
Pict.ShapeRange.PictureFormat.CropBottom = Crop
End If
End If
End If

End If 'new line
Next cell

Range("18:18,25:25,32:32,39:39").Select
Range("A39").Activate
Selection.RowHeight = 126
Range("A17").Select

Range("19:24,26:31,33:38,40:45").Select
Range("A45").Activate
Selection.RowHeight = 15
Range("A17").Select

Range("20:20,27:27,34:34,41:41").Select
Range("A41").Activate
Selection.RowHeight = 16
Range("A17").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:="12345"

Exit Sub 'new line
End Sub
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
Insert Picture using Macro marc747 Excel Programming 2 April 7th 10 01:29 PM
Insert picture using Macro.. [email protected] Excel Programming 15 June 21st 08 12:48 AM
Insert Picture Macro. scottybalotty Excel Programming 0 February 15th 06 11:05 PM
Insert Picture Macro SamDev Excel Programming 5 September 9th 05 07:09 PM
INSERT PICTURE IN MACRO Glenn Excel Programming 1 April 23rd 05 11:49 PM


All times are GMT +1. The time now is 09:00 AM.

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

About Us

"It's about Microsoft Excel"