Jan 26 2021 08:49 AM
Excel (Version 16.45[microsoft 365])
macOS Big Sur
Hi Geniuses!
I'm trying to put together a contact manager document in Excel and I'm running into a problem:
I want to had two macros
1- Make a macro to open a file picker, choose a picture and put the link in column "L" (on the same row of the contact I'm adding the picture to) and in N4
2- Make a macro that is going to show the picture when the contact is selected. (If there is a link in N4, display the picture, if not, do nothing)
This is the code I have
________________________________________________________________________________________________________
Sub Cont_AttachThumb()
Dim PicFile As FileDialog
With Sheet2
Set PicFile = Application.FileDialog(msoFileDialogFolderPicker)
With PicFile
.Title = "Select a Contact Picture"
.Filters.Add "All Picture Files", ".jpg,*jpeg,*.gif,*.png,*bmp,*tiff", 1
If .Show <> -1 Then GoTo NoSelection
Sheet2.Range("N4").Value = .SelectedItems(1) 'Put File name in N4
End With
If .Range("B3").Value = False Then .Range("L" & Sheet2.Range("B2").Value).Value = .Range("N4").Value Cont_DisplayThumb
NoSelection:
End With
End Sub
______________________________________________________________________________________________________
Sub Cont_DisplayThumb()
Dim PicPath As String
With Sheet2
On Error Resume Next
.Shapes("ThumbPic").Delete 'Delete thumbnail picture (if any)
On Error GoTo 0
PicPath = .Range("N4").Value 'Picture Path
With .Pictures.Insert(PicPath)
With .ShapeRange
.LockAspectRation = msoTrue
.Height = 80
.Name = "ThumbPic"
End With
End With
With .Shapes("ThumbPic")
.Left = Sheet2.Range("J5").Left
.Top = Sheet2.Range("J5").Top
.IncrementLeft -20
.IncrementTop 10
End With
End With
End Sub
_________________________________________________________________________________________________
The when I run it, the code that pops-up (In the title)
RUN TIME ERROR '91': OBJECT VARIABLE OR WITH BLOCK VARIABLE NOT SET
and It highlights the .Title=... in the first macro
N.B. see attached Contact MANAGER File
____________________________________________________________________________________________
What should I do next
Please help
Jan 26 2021 11:29 AM
There are several problems:
Sub Cont_AttachThum()
Dim PicFile As FileDialog
Set PicFile = Application.FileDialog(msoFileDialogOpen)
With PicFile
.Title = "Select a Contact Picture"
.Filters.Add "All Picture Files", "*.jpg;*.jpeg;*.gif;*.png;*.bmp;*.tiff", 1
If .Show <> -1 Then GoTo NoSelection
Sheet2.Range("N4").Value = .SelectedItems(1) 'Put File name in N4
End With
With Sheet2
If .Range("B3").Value = False Then
.Range("L" & .Range("B2").Value).Value = .Range("N4").Value
End With
End With
Cont_DisplayThumb
NoSelection:
End Sub
Jan 26 2021 01:19 PM
Thank you so much for your time.
Athough it is still not working, I think it is because this version of excel is "sandboxed"
Seems I'm having issues accessing files that are not in the 365 series...
Is that a known problem/issu?
Jan 26 2021 01:52 PM
Does this work?
Sub Cont_AttachThum()
Dim PicFile As FileDialog
Set PicFile = Application.FileDialog(msoFileDialogOpen)
With PicFile
.Title = "Select a Contact Picture"
.Filters.Add "All Picture Files", "*.jpg;*.jpeg;*.gif;*.png;*.bmp;*.tiff", 1
If .Show <> -1 Then GoTo NoSelection
Sheet2.Range("N4").Value = .SelectedItems(1) 'Put File name in N4
End With
With Sheet2
If .Range("B3").Value = False Then
.Range("L" & .Range("B2").Value).Value = .Range("N4").Value
End If
End With
Cont_DisplayThumb
NoSelection:
End Sub
Sub Cont_DisplayThumb()
Dim PicPath As String
Dim pic As Picture
With Sheet2
On Error Resume Next
.Shapes("ThumbPic").Delete 'Delete thumbnail picture (if any)
On Error GoTo 0
PicPath = .Range("N4").Value 'Picture Path
Set pic = .Pictures.Insert(PicPath)
With pic.ShapeRange
.LockAspectRatio = msoTrue
.Height = 80
.Name = "ThumbPic"
.Left = Sheet2.Range("J5").Left - 20
.Top = Sheet2.Range("J5").Top + 10
End With
End With
End Sub
Jan 26 2021 02:12 PM
Jan 26 2021 02:24 PM
Strange - it works for me (Excel 2019 32-bit on Windows 10 Home 64-bit).
I have attached my version.
Jan 26 2021 02:45 PM
Thank you for your time.
Still doesn't work.
I'll try to run a different excel version @Hans Vogelaar
May 13 2021 10:57 AM