Hi,
I need your help guys to solve this my problem.
I have a code for display the picture in excel.
I try this in window pc but is already run and fine.
But in the mac, I try this is run is fine but some number not found the picture then coming error "device unavailable" supposed to be display only "no pictures available" in column but not appear and stop.
Now my question is how to solve this error in mac excel.
here the code.
Option Explicit
Sub DeleteAllPictures()
Dim S As Shape
For Each S In ActiveSheet.Shapes
Select Case S.Type
Case msoLinkedPicture, msoPicture
S.Delete
End Select
Next
End Sub
Sub UpdatePictures()
Dim R As Range
Dim S As Shape
Dim Path As String, FName As String
Path = "Transcend:royal_plaza_wincash:ALL:"
If Right(Path, 1) <> ":" Then Path = Path & ":"
For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
Set S = GetShapeByName(R)
If S Is Nothing Then
FName = Dir(Path & R & ".jpg")
If FName <> "" Then
Set S = InsertPicturePrim(Path & FName, R)
End If
End If
If Not S Is Nothing Then
If S.Name <> R Then R.Interior.Color = vbRed
With R.Offset(0, -1)
S.Top = .Top
S.Width = .Width
If S.LockAspectRatio Then
If S.Height > .Height Then S.Height = .Height
Else
S.Height = .Height
End If
End With
S.ZOrder msoSendToBack
Else
R.Offset(0, -1) = "No Pictures Available"
End If
Next
End Sub
Private Function GetShapeByName(ByVal SName As String) As Shape
On Error Resume Next
Set GetShapeByName = ActiveSheet.Shapes(SName)
End Function
Private Function InsertPicturePrim(ByVal FName As String, ByVal SName As String) As Shape
Dim P As Picture
On Error Resume Next
Set P = ActiveSheet.Pictures.Insert(FName)
If Not P Is Nothing Then
Set InsertPicturePrim = P.ShapeRange(1)
P.Name = SName
End If
End Function
Bookmarks