excel - Image Control - external image Vyřešeno

[simPod]

zdravim

mam excel (:P)
tam vlozenej prvek Image Control
a potreboval bych, aby nacetl obrazek z URL, kterou mu predhodim. je to mozne? diky

[Reklama]

[mike007]

Zapni si režim návrhu, dvakrát klikni na Image control a tím otevřeš VBA.
Tam zadej toto makro:

Kód: Vybrat vše


Private Sub Image1_Click()
On Error Resume Next
Dim umisteni As String
umisteni = Application.GetSaveAsFilename("C:\", , , "Najdi obrázek nebo zadej cestu")
If umisteni <> "" Then
Image1.Picture = LoadPicture(umisteni)
Image1.PictureSizeMode = fmPictureSizeModeStretch
End If
On Error GoTo 0
End Sub



VBA zavři. Jestli chceš, aby se prvek vždy roztáhl do velikosti obrázku, v nastavení si dej Autosize-True. Poté nezapomeň vypnout režim návrhu. Nyní pokaždé když klikneš na ten ovládací prvek, otevře se ti okno abys vybral obrázek z počítače. Můžeš tam zadat i URL obrázku ...

Ukázka v příloze. Jestli máš na mysli něco jiného, tak by bylo vhodné se trošku víc rozepsat...

[simPod]

mno, cca je to uz ono. jen bych chtel, ze tomu pres promenou predam URL, treba obsah nejake bunky ve ktere je URL obrazku (ktery je online) napsana a obrazek se tam nacte

zkousel jsem v tvem prikladu nastavit promennou umisteni na:
umisteni = "http://pc-help.cz/styles/prosilver/theme/images/google.jpg"
ale to nefunguje

[X]

mike007: Paráda. U této věci jsem si říkal, že to asi nepůjde, teda že by šel vložit odkaz, ale že se nezobrazí automaticky obrázek. Klobouk dolů

simPod: Tam už to chce jen doštělovat správný formát odkazu a mrknout i do nápovědy ... například pro soubory na disku se pro odkazování používají i: [] a v některých odkazech i: /// (možná: \\\), na Net jsou v nápovědě také příklady, jen si s tím pohrát a vyzkoušet ...

P.S.: tohle později také využiji, díky.

[mike007]

Na import externích obrázků to chce silnější kalibr

Kód: Vybrat vše

Option Explicit

Private Type TGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As Long

Public Function LoadPicture(ByVal strFileName As String) As IPicture
Dim IID As TGUID
With IID
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
On Error GoTo ERR_LINE
Set LoadPicture = stdole.LoadPicture(strFileName)
Exit Function
ERR_LINE:
On Error Resume Next
OleLoadPicturePath StrPtr(strFileName), 0&, 0&, 0&, IID, LoadPicture
If LoadPicture Is Nothing Then
MsgBox "Nemohu najít " & strFileName
End
End If
End Function


Private Sub Image1_Click()
On Error Resume Next
Set Me.Image1.Picture = LoadPicture(Range("a1"))
On Error GoTo 0
End Sub

V příloze máš ukázku. URL obrázku kopíruj do buňky A1. Vždy uváděj plnou cestu, tzn. i s "http://"

[simPod]

jop, to funguje
jen mi vyhodilo hlasku, ze to neni kompatibilni se 64-bit systemem, tak jsem upravil jeden radek a tvari se, ze to funguje:

Kód: Vybrat vše

Private Declare PtrSafe Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As LongPtr, ByVal punkCaller As LongPtr, ByVal dwReserved As LongPtr, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As LongPtr

diky

[mike007]

Jestli je to ok, označ vlákno za vyřešené, ať to nestraší v TOPx