Tema: Excel VBA
View Single Post
Staro 11.08.2020., 17:59   #12
stribor919
Premium
 
Datum registracije: Aug 2014
Lokacija: vukovar
Postovi: 115
Da ne dizem novu temu, molim pomoc u vezi Excel makroa.

Macro treba na polje A1 (Ivan Ivic) ucitati sliku s hdd-a C:\slike\Ivan Ivic.jpg u comment (u novijem Excelu se zove Note) u velicini kao originalna slika, s dimenzijama commenta isto kao i slika.
Nakon toga se spusta jedno polje nize (A2) gdje pise Pero Peric i ucitava sliku C:\slike\Pero Peric.jpg itd., sve dok ne dodje do polja na kojem ne pise nista (A7) i tu staje.

Ukratko, zelim svakom polju u koloni A koje sadrzi ime i prezime dodati u comment pripadajucu sliku istog naziva iz mape C:\slike\, s tim da slika bude iste velicine kao original, a comment (Note) bude iste velicine kao slika.

Imam ovaj kod, samo sto moram rucno dodati sliku, slika nije iste velicine/omjera i nije ostra kao original (vjerojatno zato sto nije ista velicina).


Sub Pic()
'
' Pic Macro
'
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False 'Only one file
.InitialFileName = CurDir 'directory to open the window
.Filters.Clear 'Cancel the filter
.Filters.Add Description:="Images", Extensions:="*.jpg", Position:=1
.Title = "Choose image"

If .Show = -1 Then TheFile = .SelectedItems(1) Else TheFile = 0
End With
'No file selected
If TheFile = 0 Then
MsgBox ("No image selected")
Exit Sub
End If
Selection.ClearComments
Selection.AddComment
Selection.Comment.Visible = True
Selection.Comment.Shape.Fill.UserPicture TheFile
Selection.Comment.Shape.Select True
Selection.ShapeRange.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.LockAspectRatio = True
ActiveCell.Comment.Visible = True
End Sub


- Trebalo bi za svaku celiju sadrzaj kopirati u CLIPBOARD i onda ucitati sliku s lokacije C:\slike\CLIPBOARD.jpg u originalnoj velicini.
Hvala unaprijed

Zadnje izmijenjeno od: stribor919. 11.08.2020. u 19:51.
stribor919 je offline   Reply With Quote