DEVICE UNAVAILABLE

Question

Hi

I need your help guy. 

Because the problem is some reference is no picture. but the result appear screen is "DEVICE UNAVAILABLE" supposed to display "NO PICTURE AVAILABLE" but no display the message and also not continue to find the other reference number after show the "DEVICE UNAVAILABLE,

Example: 

Picture                                Reference

batman.jpg                                 btmn

CAT.jpg                                     CT

---------------                     Sprman (This area showing the "DEVICE UNAVAILABLE" after not found the picture and that no continue and stop to search the other reference. 

Please advice..

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 = "julius:Users:apple:Desktop:royal_plaza_wincash:"

    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.Left = .Left

        S.Width = .Width

        'S.LockAspectRatio = msoFalse

            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 PICTURE 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 Shape

    On Error Resume Next

    Set P = ActiveSheet.Shapes.AddPicture(FName, False, True, 1, 1, -1, -1)

    If Not P Is Nothing Then

        Set InsertPicturePrim = P

        P.Name = SName

    End If

End Function

In window this code is working and also the message "NO PICTURE AVAILaBLE"  is display and continue to find other reference.

Answer 1

Hi Jim,

Thank you for your response.

anyway the path is correct

Path = "julius:Users:apple:Desktop:royal_plaza_wincash:"

royal_plaza_wincash(all pictures is there) 

see the sample here and comment:

from excel 

Answer 2

The file path looks wrong to me. Your code says:

Path = "julius:Users:apple:Desktop:royal_plaza_wincash:"

The path should be like this:

Macintosh HD:Users:username:Desktop:FileName.xlsx

Use this worksheet function to display the file path:

=INFO("Directory")

Or in VBA use CurDir

Sub ShowDir()

MsgBox CurDir

End Sub

Answer 3

Hi khan,

no device name showing. Only the error if the reference not correct the screen message appear NO DEVICe available. Supposed to be display the NO PicTURE AVAilable. But no showing and not continue run the another referrence. In window, everthing is fine.

Answer 4

What is the name of the device given?

What is the location of the picture saved?

Change the location of the saved picture and check if the problem gets resolved.