Help with fixing my code!

[rbtjd90]

Hi,

I am in deep need of your help guys.

I need help with fixing a code that I got online to suit my needs.

I would like it to paste pictures onto the excel file I made.

I have two separate codes one for bring up the pictures using a specified path and one for auto fitting the file that i select manually.

Please help me fix the first code so that it actually works and paste the picture correctly in the right spot and auto fit it.


Here is a link to my file
https://www.dropbox.com/s/i23zhmb6v8feb1e/W Test.xlsm?dl=0

Thank You.

 

[My Aswer Is This]

I never like clicking on links due to security issues. Please post your script here:
Click on the # icon above and then paste in your code.

 

[rbtjd90]

Ok thank you,
never new i could paste like this.

Sub InsertImageShortName()    
    Application.ScreenUpdating = False


Dim pic As String ' File path of a picture
Dim cl As Range


Set Rng = Range("C50:C1000") ' Defining input range


For Each cl In Rng
    
    pic = "D:\Google Drive\ACT Pic\" & cl.Offset(0, 3) ' Location of the picture file:
                                     ' "C:\Images" folder, with particular image name
                                     ' Located in the same row, third column from A, i.e. column D


    Set myPicture = ActiveSheet.Pictures.Insert(pic) ' Inserting picture from address in D column
                                                     ' into column A
        With myPicture ' Setting picture properties
            .ShapeRange.LockAspectRatio = msoTrue ' Keep aspect ratio
            .Height = .Height ' Set your own size
            .Top = .Top
            .Left = .Left
            .Width = .Width
        End With
    Next    ' Looping to the Nth row, defined in:
            ' " Set Rng = Range("C50:C1000") "
    
    Set myPicture = Nothing
    
    Application.ScreenUpdating = True


End Sub

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