LoadPicture do Image control na listu
Dnes jsem potřeboval pracovat s prvkem "Image" z panelu ovládacích prvků přímo na pracovním listu. Standardně jsem vložil nový Image controls na list a pln elánu jsem se vrhnul do psaní kodu, který automaticky nahraje obrázek do tohoto prvku. Jaké bylo mé překvapení, když jsem zjistil, že tak rychle jak sem si to představoval to nebude. A proto vznikl tento příspěvek, abych někomu dalšímu ušetřil námahu, ale hlavně abych, když to budu potřebovat, našel i já rychle odpověď.
Samozřejmě jsem věděl, že k Image controls musím přistupovat přes OLEFormat a následně přes metodu Object a obrázek dynamicky nahrávat pomocí metody LoadPicture, ale i přesto jsem neustále dostaval chybové hlášky
Object doesn´t support this property or method
(jedna z mých oblíbených protože Vám absolutně nijak nepomůže)
Vydal sem se tedy na internet hledat pomoc, ale nedařilo se. Z očekávaných 5 min. se pomalu stávala půl hodina a řešení stále nikde. 100% jsem věděl, že jsem tuto operaci už několikrat dělal a tak sem začal s prozkoumávaním okna Locals, které mi nakonec pomohlo vyřešit, teď už jednoduchý problém. Při pohledu na přiložený obrázek si můžete všimnout dvou položek Objects a v tom byl celý zakopaný pes místo příkazu
ActiveSheet.Shapes("imgLogo").OLEFormat.Object.Picture = LoadPicture(strPathToImage & IMAGE_NAME)
patří tento lehce modifikovaný příkaz
ActiveSheet.Shapes("imgLogo").OLEFormat.Object.Object.Picture = LoadPicture(strPathToImage & IMAGE_NAME)
Celou proceduru nabízím níže.
'********************************************************************************
' LoadImageToImageControl
'
' Purpose: Loads an image from hard disc to image controls that is
' placed on a worksheet
'
' Inputs: none
'
' Outputs: none
'
' Created: August 2009 Premysl Lazecky
'
' Modified: .
'
'********************************************************************************
Sub LoadImageToImageControl()
Const IMAGE_NAME As String = "logo.gif"
Dim objImage As OLEObject
Dim strPathToImage As String
On Error GoTo ErrorHandler
strPathToImage = ActiveWorkbook.Path
If Right(strPathToImage, 1) <> Application.PathSeparator Then
strPathToImage = strPathToImage & Application.PathSeparator
End If
Set objImage = ActiveSheet.Shapes("imgLogo").OLEFormat.Object
objImage.Object.Picture = LoadPicture(strPathToImage & IMAGE_NAME)
ExitRoutine:
Set objImage = Nothing
Exit Sub
ErrorHandler:
MsgBox Prompt:="Neznama chyba v procedure 'LoadImageToImageControl'." & vbNewLine & _
"Popis chyby: " & Err.Description & vbNewLine & _
"Cislo chyby: " & Err.Number, _
Title:="Neznama chyba", _
Buttons:=vbCritical
GoTo ExitRoutine
End Sub
Komentáře
Přehled komentářů
Dobrý den vaše rada moc nefunguje potřeboval bych pomoc online
Nahrání obrázku
(Tomáš Vacek, 14. 5. 2015 20:49)