< návrat zpět

MS Excel

Téma: Jak vložit obrázek do komentáře buňky rss

Zaslal/a JanaP 11.2.2015 14:18

Ahoj,
potrebovala bych poradit, pouzila jsem macro nize, ale potrebovala bych poradit, jak tam pridat funkci "startfrom" - Jde mi o to, aby se ty obr. vlozily do komentaru automaticky a ja je ze slozky nemusela vybirat (obrazky maji vzdy totozny nazev jako bunka, kam ten komentar s obr. ma byt vlozen). Predem diky. Jana

Private Sub CommandButton1_Click()
'Vložit obrázek do komentáře buňky
Dim Filtr As String
Dim FileName As String
Dim Title As String
Dim cmt As Comment
Dim dWidth As Double
Dim dHeight As Double

'Příprava dialogového okna

'filtr vstupních souborů
Filtr = "JPG - JPG formát(*.jpg),*.jpg," & _
"BMP - Windows Bitmap(*.bmp),*.bmp," & _
"GIF - GIF formát(*.gif),*.gif," & _
"PNG - PNG formát (*.png),*.png," & _
"Všechny soubory (*.*),*.*"
'titulek dialogového okna
Title = "Vyberte soubor s obrázkem"
FileName = Application.GetOpenFilename _
(FileFilter:=Filtr, _
FilterIndex:=1, _
Title:=Title)
'ošetřit, když není vybrán žádný soubor
If FileName = "False" Then
MsgBox "Nebyl vybrán žádný soubor.", vbExclamation, "Chyba"
End
End If

'Zjištění rozměrů obrázku
ActiveSheet.Pictures.Insert(FileName).Select
dWidth = Selection.Width
dHeight = Selection.Height
Selection.Delete

'Vložení obrázku do komentáře
On Error Resume Next
With ActiveCell
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If
With cmt
.Text Text:=""
.Shape.Fill.UserPicture FileName
.Shape.Width = dWidth
.Shape.Height = dHeight
.Visible = False
End With
End With

End Sub

Zaslat odpověď >
€Ł мσşqμΐτσ(11.2.2015 18:31)#023584
€Ł мσşqμΐτσ
Ahoj,

jenom jsem trochu zkrátil a upravil zacatek makra

Private Sub CommandButton1_Click()
'Vložit obrázek do komentáře buňky
Dim Cesta As String
Dim Pripona As String
Dim FileName As String
Dim cmt As Comment
Dim dWidth As Double
Dim dHeight As Double

Cesta = "C:\Users\czprsm03\Pictures\" 'sem zadat cestu kde se ta fotka nachází
Pripona = ".jpg" 'sem zadat správnou příponu fotky

FileName = Cesta & ActiveCell & Pripona

'Zjištění rozměrů obrázku
ActiveSheet.Pictures.Insert(FileName).Select
dWidth = Selection.Width
dHeight = Selection.Height
Selection.Delete

'Vložení obrázku do komentáře
On Error Resume Next
With ActiveCell
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If
With cmt
.Text Text:=""
.Shape.Fill.UserPicture FileName
.Shape.Width = dWidth
.Shape.Height = dHeight
.Visible = False
End With
End With

End Subcitovat
JanaP(12.2.2015 17:55)#023601
avatar
Moc diky, mosquito791!

Nevis, jak bych mohla docilit toho, aby se to macro spustilo na cely konkretnni sloupec najednou (nyni musim macro spustit bunku po bunce:-( )? Dala jsem za "Dim dHeight As Double":
startfrom = InputBox("In which cell is contained your first lotnumber? Example A2.", "Input")
Range(startfrom).Select
Do Until IsEmpty(ActiveCell)

ale nejak to nefunguje.
Predem dekuji za pomoccitovat
€Ł мσşqμΐτσ(12.2.2015 21:25)#023604
€Ł мσşqμΐτσ
Ahoj,

když se jedná jenom o jeden sloupec tak použij makro viz níže a když více sloupců tak by bylo jednodušší poslat přílohu

Private Sub CommandButton1_Click()
'Vložit obrázek do komentáře buňky
Dim sloupec, bunka
Dim Cesta As String
Dim Pripona As String
Dim FileName As String
Dim cmt As Comment
Dim dWidth As Double
Dim dHeight As Double

Cesta = "C:\Users\Mosquito\Desktop\blabla\" 'sem zadat cestu kde se fotky nachází
Pripona = ".jpg" 'sem zadat správnou příponu

sloupec = 1 ' sloupec = císlo sloupce (v tomhle pripade 1 je sloupec A)

For Each bunka In Range(Cells(1, sloupec), Cells(Rows.Count, sloupec).End(xlUp))
If Not bunka = Empty Then
FileName = Cesta & bunka & Pripona
On Error Resume Next
'Zjištění rozměrů obrázku
ActiveSheet.Pictures.Insert(FileName).Select
dWidth = Selection.Width
dHeight = Selection.Height
Selection.Delete

'Vložení obrázku do komentáře

With bunka
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If

With cmt
.Text Text:=""
.Shape.Fill.UserPicture FileName
.Shape.Width = dWidth
.Shape.Height = dHeight
.Visible = False
End With
End With
On Error GoTo 0
End If
Next bunka
End Subcitovat
elninoslov(13.2.2015 0:05)#023611
elninoslov
Nevšimol som si, že to kolega už robí. Keď som pozeral naposledy, tak to tu ešte nebolo.
Každopádne som spravil svoju verziu, použil som ten jeho predošlí kód, upravil, doplnil. Funguje to aj na akýkoľvek výber, to znamená kľudne vyber aké chceš bunky, riadky, nesúvislé, to je jedno, ak nájde medzi súbormi obrázok odpovedajúci názvu bunky vo vybranej oblasti, vloží ho.

Ak chceš vkladať napr. do A20:A100, nemusíš označovať A20:A100. Označ celý stĺpec (klik na uško) a on do A1:A19 nič nevloží ak nenájde také obrázky. Ak chceš vložiť iba niektoré z obrázkov, a pritom adresár obsahuje aj obrázky korešpondujúce s inými bunkami v stĺpci, musíš logicky vybrať iba tie bunky ktoré chceš. Teda napr. máš obrázky pre A1:A100, ale chceš vložiť iba A20:A100, v tomto prípade nemôžeš označiť celý stĺpec "A" ale iba A20:A100.

Ešte to kontroluje správnosť odkazu na bunky, a samozrejme nedovolí vloženie do nevybraných buniek. Sú tam ošetrené aj nejaké chyby, ale bez Messages (to si dorob, vidíš kde je On Error, a Exit Sub).
Příloha: rar23611_jpgdocommentu.rar (109kB, staženo 51x)
citovat

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