Insert Picture From A Folder With Adjustment Border Cell (cBorder)

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,748
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
hello word...
the code below work properly for insert pictures from a folder ..i just want to set margin top, bottom, left, right in a cell..i want to the picture not "fill full" a cell

here the code :
VBA Code:
Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub
how to adding or set width and height like (2 * cBorder), etc......
related cross post

any helps, thank in advance..

.sst
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Misca

Well-known Member
Joined
Aug 12, 2009
Messages
1,626
The picture attributes (Rng.Left etc) are just numbers so you can manipulate them to get the borders to your pics:
VBA Code:
Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
Dim xColIndex As Integer
Dim xRowIndex As Integer
Dim lLoop As Integer
Dim HBorder As Integer
Dim VBorder As Integer

HBorder = 5
VBorder = 10

On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left + HBorder, Rng.Top + VBorder, Rng.Width - 2 * HBorder, Rng.Height - 2 * VBorder)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub
In my example code I've set them static but they could as well be dynamic (a percentage of the Rng height / width etc.).
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,114,071
Messages
5,545,817
Members
410,708
Latest member
SanTrapGamer
Top