[Excel VBA] Exterlinke ophalen jpeg.

[Verwijderd]

Kan iemand helpen met onderstaand probleem:

Ik wil graag een externe foto ophalen vanaf onze netwerkserver op basis van 5 criteria.

Met de volgende functie (als(en(g6=1,g5,...........);waar = extern bestand op de server);onwaar = " ")

Maar met als+en functies kun je geen externe link weergeven, hij geeft ieder geval de foto niet weer.

Volgens mij is dit wel mogelijk in VBA.

Maar ik heb geen idee, hoe het script er uit zou moeten zien

Klein voorbeeld
If ("d6"=1) and ...............
End if
End sub

Maar verder kom ik niet

Zou iemand een klein voorbeeld willen posten?

[Daos]

In de help van Excel staat dit:

AddPicture Method

Creates a picture from an existing file. Returns a Shape object that represents the new picture.

Syntax
expression.AddPicture(FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

expression Required. An expression that returns a Shapes object.
FileName Required String. The file from which the OLE object is to be created.
LinkToFile Required Long. True to link the picture to the file from which it was created. False to make the picture an independent copy of the file.
SaveWithDocument Required Long. True to save the linked picture with the document into which it’s inserted. False to storeonly the link information in the document. This argument must be True if LinkToFile is False.
Left, Top Required Single. The position (in points) of the upper-left corner of the picture relative to the upper-left corner of the document.
Width, Height Required Single. The width and height of the picture, in points.

AddPicture Method Example

This example adds a picture created from the file Music.bmp to myDocument. The inserted picture is linked to the file from which it was created and is saved with myDocument.

code:

Set myDocument = Worksheets(1)
myDocument.Shapes.AddPicture _
    "c:\microsoft office\clipart\music.bmp", _
    True, True, 100, 100, 70, 70

Programmeren in VBA lijkt simpel, maar is het niet. Je kan alles doen via VBA, maar alles staat ergens anders vergeleken met gewoon Excel (Daar doe je insert --> pictures). Je zal de help moeten leren gebruiken...

Tip: Kijk ook eens in de help bij "Range Object"

[ Voor 5% gewijzigd door Daos op 13-01-2005 20:46 ]

[Verwijderd]

Nu heb ik onderstaande formule ingevoerd als VBA =>
Function ShowPicD(PicFile As String) As Boolean
'Same as ShowPic except deletes previous picture when picfile changes
Dim AC As Range
Static P As Shape
On Error GoTo Done
Set AC = Application.Caller
If PicExists(P) Then
P.Delete
Else
'look for a picture already over cell
For Each P In ActiveSheet.Shapes
If P.Type = msoLinkedPicture Then
If P.Left >= AC.Left And P.Left < AC.Left + AC.Width Then
If P.Top >= AC.Top And P.Top < AC.Top + AC.Height Then
P.Delete
Exit For
End If
End If
End If
Next P
End If
Set P = ActiveSheet.Shapes.AddPicture(PicFile, True, True, AC.Left, AC.Top, 200, 200)
ShowPicD = True
Exit Function
Done:
ShowPicD = False
End Function

Function PicExists(P As Shape) As Boolean
'Return true if P references an existing shape
Dim ShapeName As String
On Error GoTo NoPic
If P Is Nothing Then GoTo NoPic
ShapeName = P.Name
PicExists = True
NoPic:
PicExists = False
End Function

En die roep ik aan in mijn excel blad =>
=ShowPicD("G:\Foto reparatieklemmen\C-clamp.jpg")

Maar als ik er een als functie van maak dan functioneert hij niet meer, wat is het probleem?

[Daos]

Als je de tags [code=vb] en [⁄code] gebruikt komen er leuke kleurtjes in je post te staan. Je code ziet er ook niet uit. Lees de P&W-FAQ eens door.


Het duurde even voordat ik door had dat die functie in een module moet voordat je hem kan gebruiken (link).

Wat je hebt werkt gewoon. Je krijgt geen plaatje te zien als je plaatje niet bestaat. In dit geval geeft ShowPicD False terug.
Verder moet je er rekening mee houden dat de functie pas wordt uitgevoerd als er iets in de cellen veranderd is. Dat kan opgelost worden door events af te vangen (Open, Activate) en daar alles opnieuw te laten berekenen. Sheet1.Calculate werkt bij mij maar 1 keer, maar Application.CalculateFull doet het daarentegen wel goed.

Verder nog:
- De functie PicExists geeft altijd False.
- Static P As Shape. Geeft problemen bij meerdere cellen met plaatjes.


Ik zou het zo doen:

Visual Basic:

Function ShowPicD(PicFile As String) As String
'Same as ShowPic except deletes previous picture
    On Error GoTo Failure

    Dim PrevPic As String
    Dim AC As Range

    Set AC = Application.Caller
    PrevPic = AC.Text

    If PicExists(PrevPic) Then
        ActiveSheet.Shapes(PrevPic).Delete
    End If

    ShowPicD = ActiveSheet.Shapes.AddPicture(PicFile, True, True, AC.Left, AC.Top, 200, 200).Name
    Exit Function

Failure:
    ShowPicD = "Error loading: " + PicFile
End Function

Visual Basic:

Function PicExists(PictureName As String) As Boolean
'Returns true if PictureName is the name of an existing shape
    On Error GoTo NoPic

    If Not (ActiveSheet.Shapes(PictureName) Is Nothing) Then
        PicExists = True
        Exit Function
    End If

NoPic:
    PicExists = False
End Function

.
.
.
Of zo (ook met PicExists die hierboven staat):

Visual Basic:

Function ShowPicD(PicFile As String) As String
'Same as ShowPic except deletes previous picture when PicFile changes
    On Error GoTo Failure
    
    Dim PrevPicId  As String
    Dim PrevPicFile As String
    
    Dim AC As Range
    Set AC = Application.Caller
    
    PrevPic = AC.Text
    Delimiter = InStr(PrevPic, "|")
    If (Delimiter > 0) Then
        PrevPicId = Left(PrevPic, Delimiter - 1)
        PrevPicFile = Right(PrevPic, Len(PrevPic) - Delimiter)
    End If

    If PicExists(PrevPicId) And StrComp(PicFile, PrevPicFile) = 0 Then
        ShowPicD = PrevPic
    Else
        If PicExists(PrevPicId) Then
            ActiveSheet.Shapes(PrevPicId).Delete
        End If
        
        PicId = ActiveSheet.Shapes.AddPicture(PicFile, True, True, AC.Left, AC.Top, 200, 200).Name
        ShowPicD = PicId + "|" + PicFile
    End If
    
    Exit Function

Failure:
    ShowPicD = "Error loading " + PicFile
End Function

[ Voor 66% gewijzigd door Daos op 15-01-2005 00:23 ]