Results 1 to 7 of 7

Thread: VBA : Insert Pictures With Multiple Select Picture & Consecutive Placing

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Member
    Join Date
    Sep 2013
    Posts
    37
    Rep Power
    0

    VBA : Insert Pictures With Multiple Select Picture & Consecutive Placing

    Cross posted
    http://www.eileenslounge.com/viewtop...292701#p292701






    hi expert..

    this macro code below working properly to insert picture from a folder with one by one select picture
    i want to modified so macro work with criteria:
    1. can insert picture from a folder with multiple select picture and insert to multiple cell at once
    2. pictures can inserted automatically consecutive/sequentially placing into target cell (target cell are random) with name of file picture are random --> (main option)
    3. if point #2 impossible to do it , to insert automatically consecutive can use name of file picture or based on name pictures like e.g. photo1, photo2,photo3, photo4, or whatever name's file picture etc....> (secondary option)
    here code
    Code:
    Sub InsertPicture()    Const cBorder As Double = 5     ' << change as required
        Dim vPicture As Variant, pic As Shape
        vPicture = Application.GetOpenFilename("Pictures (*.gif; *.jpg; *.jpeg; *.tif), *.gif; *.jpg; *.jpeg; *.tif", , "Select Picture to Import")
        If vPicture = False Then Exit Sub
       Set pic = ActiveSheet.Shapes.AddPicture(Filename:=vPicture, LinkToFile:=False, SaveWithDocument:=True, _
                    Left:=ActiveCell.MergeArea.Left + cBorder, Top:=ActiveCell.MergeArea.Top + cBorder, Width:=-1, Height:=-1)
        With pic
            .LockAspectRatio = False       ' << change as required
             If Not .LockAspectRatio Then
                .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
                .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
            Else
                If .Width >= .Height Then
                    .Width = ActiveCell.MergeArea.Width - (2 * cBorder)
                Else
                    .Height = ActiveCell.MergeArea.Height - (2 * cBorder)
                End If
            End If
            .Placement = xlMoveAndSize
        End With
        Set pic = Nothing
    End Sub
    any help, greatly appreciated..
    susanto
    Last edited by DocAElstein; 02-21-2022 at 02:24 PM.

Similar Threads

  1. Replies: 3
    Last Post: 07-09-2020, 02:17 AM
  2. Replies: 0
    Last Post: 07-08-2020, 07:43 PM
  3. Macro To Browse&Select File and import Specific Data
    By madeinnorway in forum Excel Help
    Replies: 0
    Last Post: 09-20-2019, 01:24 AM
  4. Insert Different Picture into Multiple Sheets
    By muhammad susanto in forum Excel Help
    Replies: 4
    Last Post: 08-28-2018, 12:01 PM
  5. Insert Picture in a Cell UDF
    By Admin in forum Download Center
    Replies: 10
    Last Post: 12-07-2012, 04:49 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •