I have a VBA code for Auto Picture insert in Excel from a network folder with reference to active cell size. This Macro works fine with the Excel 2003 but when working with 2007 the image size doesn't fits to the cell. Kindly go through the Following code & help me.
How It works I will tell you guys in Summary. Get the image name in one column which are stored on a network drive in An EXcel. Map the network drive on which images are stored. Then open the file wich is attached here. This file contains the VBA Code. & press Ctrl+L to auto insert the images in next to the columns where image name are mentioned.
Sub Jebs()
On Error GoTo errhandler:
Dim A
'A = Range(Mid(ActiveCell.Address, 2, 1) & 1)
A = Range(Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2) & 1)
If Range(A & ActiveCell.Row) = "" Then
MsgBox "No Design No", vbInformation
Exit Sub
End If
Set fso = CreateObject("Scripting.Filesystemobject")
If Not fso.driveexists("j:\") Then
MsgBox "j: Not Exists Or Not Enabled", vbExclamation
Exit Sub
End If
Set drv = fso.GetDrive(fso.GetDriveName("j:"))
'If drv.serialnumber <> -1871811936 Then
'MsgBox "Unauthorised copy of Picture Insert or you may have changed your disk drives"
' Exit Sub
'End If
If fso.fileexists("J:\facet photos\" & Replace(Range(A & ActiveCell.Row), " ", "") & ".jpg") Then
ActiveSheet.Pictures.Insert("J:\facet photos\" & Replace(Range(A & ActiveCell.Row), " ", "") & ".jpg").Select
Set Kfile = fso.getfile("J:\facet photos\" & Replace(Range(A & ActiveCell.Row), " ", "") & ".jpg")
Else
ActiveSheet.Pictures.Insert("J:\facet photos\" & Replace(Range(A & ActiveCell.Row), " ", "") & ".bmp").Select
Set Kfile = fso.getfile("J:\facet photos\" & Replace(Range(A & ActiveCell.Row), " ", "") & ".bmp")
End If
Selection.Left = ActiveCell.Left + 1
Selection.Top = ActiveCell.Top + 1
Selection.Height = ActiveCell.Height - 1
Selection.Width = ActiveCell.Width - 1
Range(Mid(ActiveCell.Address, 2, 1) & ActiveCell.Row + 1).Activate
Range((Mid(ActiveCell.Address, 2, 1)) & ActiveCell.Row).Select
Exit Sub
errhandler:
If Err.Number = 1004 Then
MsgBox "File with this Design No not found", vbInformation
Else
MsgBox Err.Description
End If
End Sub