Snasui Excel Forum

Code: Select all

Sub FindAndOpenFiles()
    Dim strFolder As String
    Dim strFileName As String
    Dim objPic As Picture
    Dim rngCell As Range

    strFolder = "C:\Users\Administrator\Desktop\Size\"
    If Right(strFolder, 1) <> "\" Then
        strFolder = strFolder & "\"
    End If

    Set rngCell = Range("A1")

    strFileName = Dir(strFolder & "*.jpg", vbNormal)

    Do While Len(strFileName) > 0
        Set objPic = ActiveSheet.Pictures.Insert(strFolder & strFileName)
        With objPic
            .Left = rngCell.Left
            .Top = rngCell.Top
            .Height = rngCell.RowHeight
            .Placement = xlMoveAndSize
        End With
        Set rngCell = rngCell.Offset(1, 0)
        strFileName = Dir
    Loop

End Sub

Code: Select all

Sub FindAndOpenFiles()
Dim picname As String
ActiveSheet.Pictures.Insert ("C:\Users\Administrator\Desktop\Size")
Do Until picname = ""
For i = 3 To Range("b1048576").End(xlUp).Row
    
    With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 150#
.ShapeRange.Width = 150#
.ShapeRange.Rotation = 0#
End With
         Next i
         Loop
End Sub

Code: Select all

Sub Macro1()
Range("A1").Select
Dim picname As String
For i = 3 To Range("b1048576").End(xlUp).Row
Range("c" & i).Select
picname = Range("B4")
ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\Size\" & picname & ".jpg").Select
With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 150#
.ShapeRange.Width = 150#
.ShapeRange.Rotation = 0#
 End With
    Next i
End Sub

Code: Select all

Sub Macro1()
Range("A1").Select
Dim picname As String
picname = Range("B4")
ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\Size\" & picname & ".jpg").Select
With Selection
.Left = Range("A1").Left
.Top = Range("A1").Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 150#
.ShapeRange.Width = 150#
.ShapeRange.Rotation = 0#
End With


End Sub

Code: Select all

    Sub FindAndOpenFiles()
    Dim FilePath As String
    Dim fileName As String
    Dim wbFound As Workbook
    FilePath = "C:\Users\Administrator\Desktop\Size"
    fileName = Dir(FilePath & ".jpg")
    Do Until fileName = ""
        Set wbFound = Workbooks.Open( _
            fileName:=FilePath & "\" & fileName)
        fileName = Dir()
    Loop
End Sub

Code: Select all

Sub Macro2()
For i = 3 To Range("b1048576").End(xlUp).Row
Range("c" & i).Select
    ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\Size\" & Range("b" & i).Value & ".jpg").Select
    
    With Selection
    .Height = ActiveCell.Height - 10
    .ShapeRange.IncrementTop 10
    .ShapeRange.IncrementLeft (ActiveCell.Width - Selection.Width) / 2
    End With
    Next i
    End Sub
    

Code: Select all

Sub Macro2()
For i = 3 To Range("b1048576").End(xlUp).Row
Range("c" & i).Select
    ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\Size\" & Range("b" & i).Value & ".jpg").Select
    
    With Selection
    .Height = ActiveCell.Height - 10
    .ShapeRange.IncrementTop 10
    .ShapeRange.IncrementLeft (ActiveCell.Width - Selection.Width) / 2
    End With
    Next i
    End Sub
    

Code: Select all

Sub Macro2()
For i = 3 To Range("b1048576").End(xlUp).Row
Range("c" & i).Select
    ActiveSheet.Pictures.Insert("C:\Users\Administrator\Desktop\Size\" & Range("b" & i).Value & ".jpg").Select
    
    With Selection
    .Height = ActiveCell.Height - 10
    .ShapeRange.IncrementTop 10
    .ShapeRange.IncrementLeft (ActiveCell.Width - Selection.Width) / 2
    End With
    Next i
    End Sub