You are here:

Excel/Entering multiple images in excel

Advertisement


Question
QUESTION: I am using excel 2010. I am a level 7.

1. I have 430 .jpg images in folder C:1. LP software05-13-1130-1630-SA-RAS-mpeg4-
2. The first two images are differnt in size. The first image is 640X480. The second image is a zoom of a portion of the first image - its size is 140X80.
3. The subsequent images are similar pairs as described in 2.
4. the cell is set up to fit the smaller image (140X80).
4. I would like to be able to insert the first image in A1 and the second image in B1. I would like the first image (640X408)to be reduced in size so that it will fit in A1 which will be the size to fit second image (140X80).
5. I would like to have the subsequent pairs be inserted in order into A2-B2,A3-B3, etc.

Thanks for your help!

Ben

ANSWER: Hi Ben,

You didn't mention the order you want the images inserted.  They could just be inserted in alphanumeric order by file name, or perhaps an order dictated by a file naming convention you devised, such as embedding the row that you want them inserted into in the file name. Just as important, how are the file names of the small and corresponding large images related?  The code must use this relationship to find the small image that pairs with the larger image. For example, if the large image is image0021.jpg, the small image could be image0021_small.jpg so the code could just look for the same name with a _small suffix.

Also, is "1. LP software05-13-1130-1630-SA-RAS-mpeg4-" your folder name, or do the hyphens indicate backslash folder separators?

Because each of your 640x480 files will be approximately 85 KB in size, your workbook will be at least 36 MB in size, which would make it slow to load and unwieldy handle. It is possible to insert all the smaller 140x80 pictures but only load and insert the larger 640x480 "on demand", for example when that row or a cell in that row is selected, etc. This could greatly reduce your workbook size. Let me know if you would like me to set it up to do this on demand loading.

Damon



---------- FOLLOW-UP ----------

QUESTION: I had previously contacted another expert who said that he could not accomplish what I wanted to do. I then asked you.

I then recontacted the first expert with some further explanation and he proceded to work on the project and complete it. I like your idea of reduing the workbook size and would like to see your end product but do not feel that I should ask you to do the work a second time.

Thanks!

Ben

ANSWER: Ben,

Thanks for your consideration.

If you do get to the point where you need the "on demand picture loading" feature, feel free to post the question. I have implemented this several times in the past so it would not be an excessive amount of work.

Damon

---------- FOLLOW-UP ----------

QUESTION: I would like to take you up on your offer of adding the "on demand picture loading" feature.

Below is the macro as it is today:

Sub PicAction()
s = Application.Caller
Set pic = ActiveSheet.Pictures(s)
If pic.Height > 200 Then
pic.Height = 80
pic.Width = 109
pic.Left = Cells(1, "B").Left
Else
pic.Height = 480
pic.Width = 640
pic.Left = Cells(1, "C").Left
End If
End Sub


Sub checkfiles()
Dim sPath As String, sName As String
Dim sFirst As Boolean, rw As Long
Dim pic As Picture
Dim r As Range
sFirst = True
rw = 1
sPath = "C:\1. LP software\05-13-1130-1630-SA-RAS-mpeg4-\"
'sPath = "D:\C_Drive\Data\"
sName = Dir(sPath & "*.jpg")
Do While sName <> ""
If sFirst Then
   Set r = Cells(rw, 1)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter ' text on the left
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top   ' Picture at the top
   pic.Left = r.Left
   'Column A, image does not need to be reduced
   pic.Height = 80
   pic.Width = 140
'     pic.OnAction = "PicAction"
   sFirst = False
Else
   
   Set r = Cells(rw, 2)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter ' text on the left
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction"
   Cells(rw, 2) = sName
   sFirst = True
   rw = rw + 1
End If
sName = Dir()
Loop
End Sub

Below I answer your two questions and describe the finished product as it is now:

1.  The images are in the folder “C:\1. LP software05-13-1130-1630-SA-RAS-mpeg4-\". They are arranged according to name. The pairs both have a “date and time stamp_1”.  The subsequent pair have “date and time stamp_2”,  “date and time stamp_3”, etc. as shown below.  The full frame (640X380) has only. jpg – the smaller image(140X80) has –LP.jpg. I have the small image in column A, the large image in column B reduced to 109X80 and with a mouse click the “large frame goes to column C at 640X480.

2013-05-13-10-32-18_1.jpg
2013-05-13-10-32-18_1-LP.jpg
2013-05-13-10-32-21_2.jpg
2013-05-13-10-32-21_2-LP.jpg
2013-05-13-10-38-37_3.jpg
2013-05-13-10-38-37_3-LP.jpg
2013-05-13-10-40-05_4.jpg
2013-05-13-10-40-05_4-LP.jpg
2013-05-13-10-40-48_5.jpg
2013-05-13-10-40-48_5-LP.jpg

Thanks in advance for adding the "on demand picture loading" feature.

Ben

Answer
Hi Ben,

I finally got around to the on demand loading version.  Here's the code:

_________________________________________________________

Const sPath = "C:\1. LP software\05-13-1130-1630-SA-RAS-mpeg4-\"

Sub PicAction2()
  Dim Pic          As Picture
  Dim PicFS         As Picture
  Dim iRow          As Long
  Dim PicName       As String
  Dim PicFileName   As String
  Dim PicNameFS     As String   'Name of full size picture
  
  PicName = Application.Caller
  Set Pic = ActiveSheet.Pictures(PicName)
  iRow = Pic.TopLeftCell.Row
  'Get picture file name from cell in column B
  PicFileName = Pic.TopLeftCell.Value
  PicNameFS = Left(PicFileName, Len(PicFileName) - 4) & "-FS.jpg" 'add -FS file name suffix
  
  If PicExists(PicName & "FS") Then
     'picture already exists, so delete it
     ActiveSheet.Pictures(Pic.Name & "FS").Delete
  Else
     'picture doesn't exist, so insert it in column C of same row as Pic
     On Error GoTo PicNotFound
     Set PicFS = ActiveSheet.Pictures.Insert(sPath & PicNameFS)
     PicFS.Top = Pic.Top
     PicFS.Left = Columns("C").Left
     PicFS.Name = PicName & "FS"
  End If
  
  Exit Sub
  
PicNotFound:
  MsgBox "Picture " & PicNameFS & " not found.", vbExclamation, "Full Size Image"

End Sub

Function PicExists(PicName As String)
  'This function returns TRUE if picture named PicName exists on the active sheet
  Dim Pic     As Picture
  On Error GoTo NoSuchPic
  Set Pic = ActiveSheet.Pictures(PicName)
  PicExists = True
  Exit Function
NoSuchPic:
  PicExists = False
End Function


Sub InsertPics()
  Dim sName As String
  Dim iRow As Long
  Dim Pic As Picture
  Dim r As Range
  'sPath = "C:\1. LP software\05-13-1130-1630-SA-RAS-mpeg4-\"

  sName = Dir(sPath & "*.jpg")
  Do While sName <> ""
     iRow = RowFromFilename(sName)
     If sName Like "*-LP.jpg" Then
        Set r = Cells(iRow, "A")
        r.Value = sName
        r.VerticalAlignment = xlBottom ' text at the bottom
        ' r.HorizontalAlignment = xlCenter ' text on the left
        Set Pic = ActiveSheet.Pictures.Insert(sPath & sName)
        Pic.ShapeRange.LockAspectRatio = False
        Pic.Top = r.Top ' Picture at the top
        Pic.Left = r.Left
        'Column A, image does not need to be reduced
        'Pic.Height = 80
        'Pic.Width = 140
        ' pic.OnAction = "PicAction"
        Pic.Name = "PicA" & iRow
     ElseIf Not sName Like "*-FS.jpg" Then  'rule out full size pictures
        'Now do 80 x 109 pictures in column B
        Set r = Cells(iRow, "B")
        r.Value = sName
        r.VerticalAlignment = xlBottom ' text at the bottom
        ' r.HorizontalAlignment = xlCenter ' text on the left
        Set Pic = ActiveSheet.Pictures.Insert(sPath & sName)
        Pic.ShapeRange.LockAspectRatio = False
        Pic.Top = r.Top ' Picture at the top
        Pic.Left = r.Left
        ' column B, image needs to be reduced
        'pic.Height = 80
        'pic.Width = 109
        Pic.OnAction = "PicAction2"
        Pic.Name = "PicB" & iRow
        Cells(iRow, 2) = sName
     End If
     sName = Dir()
  Loop
End Sub

Function RowFromFilename(Filename As String) As Long
  'Gets row number from file name
  'e.g., 2013-05-13-10-38-37_5-FS.jpg would be row 5
  '  after the last underscore but before hyphen or ".jpg"
  Dim ChNoBegin     As Integer  'Character number of begin of number
  Dim ChNoEnd       As Integer  'Character number of end of number
  
  ChNoBegin = Len(Filename) - InStr(1, StrReverse(Filename), "_") + 2
  
  ChNoEnd = InStr(ChNoBegin, Filename, "-")
  If ChNoEnd = 0 Then
     'no FS or LP suffix, so assume number followed by ".jpg"
     ChNoEnd = Len(Filename) - 4
  Else
     ChNoEnd = ChNoEnd - 1
  End If
  
  On Error GoTo NotFound
  
     RowFromFilename = CLng(Mid(Filename, ChNoBegin, ChNoEnd - ChNoBegin + 1))
     Exit Function
NotFound:
     RowFromFilename = 0
     
End Function
___________________________________________________________

Important Explanation:

Since the purpose of the demand-loading version is to reduce file size, this version assumes that the files without the _LP suffix are NOT the full-size files, but are the full-size files reduced to 140x80.  The way you currently have it the picture in column B is a full-size picture (taking up full full size picture memory), but just displayed smaller.  Now it isn't until you click on the pictures in column B that the full size file is located.  The full-size file is assumed to have a "-FS" suffix.  So now you have three files for each picture.

Because of the demand loading, I also set it up as before to load the picture with a click on the picture in column B.  But I also made it so that a second click will delete the picture.

In addition, this version uses the index number at the end of the file name as the row number where the picture will be inserted.  This prevents a potential problem with the Dir() function not returning the file names in the order you want, so they could end up in the wrong rows.

Let me know if any problems.

Damon

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Damon Ostrander

Expertise

I have extensive experience with VBA programming in Excel 5 through Excel 2013. As a former aerospace engineer with a large aerospace corporation and consultant in a small defense technology services company, I have developed a wide range of applications in VBA, including simulations involving mixed-language programming, satellite orbit mechanics, graphics and animation, and real-time applications. I am interested in moderate to hard VBA-related questions only.

Experience

I have developed and taught several courses in Excel VBA programming and also VBA programming in Office 97, 2000, and 2007. I have developed a number of large technical applications in Excel VBA for use within the aerospace industry.

Education/Credentials
B.S. in Electrical Engineering and Computer Science, University of California, Berkeley.

©2016 About.com. All rights reserved.