< návrat zpět

MS Excel


Téma: Vložení obrázku do userform image rss

Zaslal/a 17.11.2020 21:04

zdenaTak Vás opět zdravím.
prosím o pomoc, přeinstalovala jsem MS office komplet včetně Outlooku.
Měla jsem v listu("obr") několik grafů i obrázků...
Jakmile jsem spustila program, zkolaboval s hláškou verze 64 bit..
Prosím, snažně, pošlete mi VBA kód pro přesun ( vložení ) obrázku do Userform. Děkuji
Jediné co funguje je správný počet obrázků v zdroj.listu (obr)
Starý kód ani nepřikládám 6

Zaslat odpověď >

#048908
zdena
Pro upřesnění.
V UserForm mám image1, který dle hodnoty spinbutton1 změní načte obrázky (vloží) z listu ("obr") právě do image1. Asi to lépe nepopíšu. Zdroj není na HDD nýbrž v programu na 1 listu ("obr").
Prosím, prosím o pomoc 1
Děkuji moccitovat
#048910
Fantasyk
Jak mám napsané asi o 5 článků níže...
Private Sub UserForm_Initialize()

Dim Dateiname As String, Graf As Chart

Set Graf = Sheets("Vyhledat").ChartObjects("Graf 7").Chart

Dateiname = ThisWorkbook.Path & "\graf.gif"

Graf.Export Filename:=Dateiname, FilterName:="GIF"

'Image1.Picture = LoadPicture(Dateiname)

Sheets("Lisy - Vedouci smen").Select

'Add Dynamic Image and assign it to object 'Img'

Set Img = UserForm2.Controls.Add("Forms.Image.1")



With Img

'Load Picture to Image Control

.Picture = LoadPicture(Dateiname)



'Align the Picture Size

'.PictureSizeMode = fmPictureSizeModeStretch

.Width = 717

.Height = 460

'Image Position

.Left = 20

.Top = 100

End With

End Sub
citovat
#048916
zdena
Katastrofální selhání!
Nemám dobře nastavenou adresu odkazu
Dateiname = "": Soubor je uložen c:\Excel\montix03.xlsm, obsahuje 3 listy a Graf 1, Obrázek 6 ajiné jsou uloženy v listu "obr"
Private Sub UserForm_Initialize()
'On Error Resume Next
Dim Dateiname As String, Graf As Chart
Set Graf = Sheets("obr").ChartObjects("Graf 1").Chart
Dateiname = ThisWorkbook.Path & "\graf1.gif"
MsgBox Dateiname
Graf.Export Filename:=Dateiname, FilterName:="GIF"
UF1.Image5.Picture = LoadPicture(Dateiname)
Sheets("obr").Select
'Add Dynamic Image and assign it to object 'Img'
Set Img = UF1.Controls.Add("Forms.Image5")
With Img
'Load Picture to Image Control
.Picture = LoadPicture(Dateiname)
'Align the Picture Size
'.PictureSizeMode = fmPictureSizeModeStretch
'.Width = 717
'.Height = 460
'Image Position
'.Left = 20
''.Top = 100
End With
End Subcitovat
#048919
zdena
Dateiname = "C:\Excel\\graf1.gif", ale bez On Error resume next to hlásí - nesprávný řetězec třídy
6citovat
#048920
zdena
V původním programu se graf neukládal na HDD, nýbrž jsem volil číslo z počtu obrázků na listu. Tento návrh nenačte Obrázky, ale pouze graf, který uloží na HDD
Přesto děkuji a opět prosím o pomoc s mým trápením..
1citovat
#048926
elninoslov
Také niečo bude trochu krkolomné.
Do modulu:
Sub StartForm()
UserForm1.Show
End Sub


Do formulára:
Dim aPic() As Shape
Dim cPic As Long
Dim ch As ChartObject
Dim stmpFile As String

Private Sub SpinButton1_Change()
If cPic > -1 Then SetImage aPic(SpinButton1.Value)
End Sub

Private Sub UserForm_Initialize()
Dim SHP As Shape
cPic = -1
For Each SHP In wsObr.Shapes
If SHP.Type = msoPicture Then
cPic = cPic + 1
ReDim Preserve aPic(cPic)
Set aPic(cPic) = SHP
End If
Next SHP

If cPic > -1 Then
Set ch = wstmpgraf.ChartObjects("tmpgraf")
stmpFile = ThisWorkbook.Path & "\pic_tmp.bmp"
SpinButton1.Max = cPic
SetImage aPic(0)
End If
End Sub

Sub SetImage(ByRef SHP As Shape)
SHP.Copy
ch.Select
With ch.Chart
.Paste
.Export stmpFile
End With
Image1.Picture = LoadPicture(stmpFile)
Label1.Caption = SpinButton1.Value
End Sub

Private Sub UserForm_Terminate()
On Error Resume Next
Kill stmpFile
Erase aPic
Set ch = Nothing
End Sub


CodeName listu s obrázkami : wsObr
CodeName skrytého listu s potrebným pracovným grafom : wstmpgraf
Dočasne vytváraný súbor s obrázkom v aktuálnom umiestnení : pic_tmp.bmp
Příloha: zip48926_obrazok-z-listu-do-formu.zip (344kB, staženo 25x)
citovat
#048952
zdena
Chci tímto poděkovat všem, co mi přispěli a pomohli.
Moc moc všem děkuji.
Přiložený zip soubor pracuje přesně jako ten můj původní.
I ten program pro uložení grafu na HDD také využiji.
Nedá se vyjádřit jak jsem vám oběma vděčná a toho času, co jste mi ušetřili.
Děkuji a přeji hezký den
1 1 1 1 1 1citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje