Insert and Resize Pictures for Photo Log Template

WildBurrow

New Member
Joined
Apr 5, 2021
Messages
41
Office Version
  1. 365
Platform
  1. Windows
I'm creating a photo log template that will allow Users to select up to four images (portrait orientation) per sheet. The pictures should be aligned with the top right position of cells A1, S1, A26, and S26. Under each picture, there are two cells that allow for User input: Direction of View" and "Description of View". I envision four command buttons (one for each of the picture placeholders) that will prompt the User to select the picture then insert the picture and resize to fit the specific area while maintaining an aspect ratio of the original picture.
Sample Photo Log.jpg


I've cobbled together some code but it places the picture where it wants to, regardless of how I try to define the desired cell location. Can anyone help me fine tune this?

VBA Code:
Private Sub Insert1of4Portrait()
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Insert"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then
            Dim img As Object
            Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
            With img
            .Top = Range("S26").Top
            .Left = Range("S26").Left
            .ShapeRange.LockAspectRatio = msoTrue
            .Width = 279
End With
        Else
            MsgBox ("Picture Insert Cancelled")
        End If
    End With
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
I'm creating a photo log template that will allow Users to select up to four images (portrait orientation) per sheet. The pictures should be aligned with the top right position of cells A1, S1, A26, and S26. Under each picture, there are two cells that allow for User input: Direction of View" and "Description of View". I envision four command buttons (one for each of the picture placeholders) that will prompt the User to select the picture then insert the picture and resize to fit the specific area while maintaining an aspect ratio of the original picture.
View attachment 49600

I've cobbled together some code but it places the picture where it wants to, regardless of how I try to define the desired cell location. Can anyone help me fine tune this?

VBA Code:
Private Sub Insert1of4Portrait()
With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Insert"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then
            Dim img As Object
            Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
            With img
            .Top = Range("S26").Top
            .Left = Range("S26").Left
            .ShapeRange.LockAspectRatio = msoTrue
            .Width = 279
End With
        Else
            MsgBox ("Picture Insert Cancelled")
        End If
    End With
End Sub
Discovered code that would place the image in the correct cell and allow me to resize.
This link:

Insert picture
 
Upvote 0
Solution

Forum statistics

Threads
1,223,888
Messages
6,175,203
Members
452,617
Latest member
Narendra Babu D

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top