Insert Gambar dengan Klik Button

wah thx berat btw bos, kl kita ingin nempatin nya di cell tertentu gmn?

Halo Red,

Coba code berikut:

Sub insertpic()
'Deklarasi variabel untuk menampung nama file.
Dim Filetoopen
'Deklarasi variabel untuk meletakkan gambar pada posisi cell yang aktif.
Dim pic As Object, alamattop As Double, alamatleft As Double

'Memunculkan Dialog Window untuk memilih File Gambar. Hasilnya di berupa nama dan Path file dan disimpan di variabel Filetoopen.
'Tipe file yang bisa dibuka adalah JPG dan PNG. Tipe file ini bisa disesuaikan dengan kebutuhan.
Filetoopen = Application.GetOpenFilename("Picture File (*.jpg), *.jpg,(*.png), *.png", , "Insert Picture", , False)

'Men-set variabel pic menjadi holder Perintah untuk insert file.
'File yang diinsert sesuai dengan nama dan path file yang sebelumnya dipilih.
Set pic = ActiveSheet.Pictures.Insert(Filetoopen)

'ambil alamat cell yang aktif
alamattop = Range(ActiveCell.Address).Top
alamatleft = Range(ActiveCell.Address).Left

'Meng-insert gambar dan meletakkan gambar pada alamat yang aktif
With pic
.Top = alamattop
.Left = alamatleft
End With

End Sub

---

Dengan code diatas, maka gambar akan disisipkan pada cell yang aktif (cell yang dipilih).

Semoga bermanfaat.
salam
Klinik Excel

script vba ini sudah bagus,,,

tapi klik tombol, terus kita gak ajdi uplaod gambarnya atau klik tombol CANCEL,,, script nya error

mohon solusinya

saya ingin membuat tampilan di excel 2007 seperti di access (Switchboard manager) mohon bantuannya

Hai Mas Samsul,

Mohon untuk mengirimkan permintaan atau pertanyaan diluar topik ini melalui forum kami.

http://www.klinikexcel.com/forum/index.html

terima kasih atas kunjungannya di klinik excel.

maaf bos,,, kl kita ingin nempatin di tapi image udah nge strecth sendiri,, misalkan range cell A1, insert pic trus image yg kluar otomatis nge fit ukuran cell tersebut,, 
mohon bantuannya,,

note : saya sbnernya ingin membuat formulir registrasi, cmn untuk semuanya sheet saya lock untuk 'locked cells'. jadi cmn cell yg 'unlocked' doang yg bisa diisi oleh pelamar,, nah dibawahnya ada cell ukurannya sudah saya buat sedemikian rupa buat disisipi image, tapi ternyata setelah review sheet saya lock, macro tsb jd ga berfungsi dan misalkan berfungsi ukuran gambar yg saya ambil ga nge fit ukuran cell,,,
wah saya kyk curhat,,,

Thx before

Hai Red,

Berarti harus Buka proteksi, Run Macro, Tutup Proteksi.

Coba code berikut:

Sub insertpic()
'Deklarasi variabel untuk menampung nama file.
Dim Filetoopen

'Men-set variable myDoc sebagai holder Worksheets yang dipakai
'Ganti angka 1 sesuai dengan nama/nomor worksheets yang dipakai.
Set myDoc = Worksheets(1)

'Pastikan dokumen dalam kondisi ter-protect
'Menghilangkan proteksi dokument(sheet)
myDoc.Unprotect Password:=""

'Memunculkan Dialog Window untuk memilih File Gambar. Hasilnya di berupa nama dan Path file dan disimpan di variabel Filetoopen.
'Tipe file yang bisa dibuka adalah JPG dan PNG. Tipe file ini bisa disesuaikan dengan kebutuhan.
Filetoopen = Application.GetOpenFilename("Picture File (*.jpg), *.jpg,(*.png), *.png", , "Insert Picture", , False)

'ambil alamat cell yang aktif
alamattop = Range(ActiveCell.Address).Top
alamatleft = Range(ActiveCell.Address).Left

'Insert gambar yang dipilih pada alamat cell
'ukuran gambar adalah height = 100, dan Width = 100
myDoc.Shapes.AddPicture Filetoopen, False, True, alamatleft, alamattop, 100, 100

'mem-protect kembali dokumen
myDoc.Protect Password:=""

wah,,, thx a lot,,
saya coba dl bos...

anu bro,,, misalkan setelah saya insert pic, tp ternyata salah pic yg saya ambil,, 
dengan kode macro di atas sheet mesti di unprotect dl,, kl insert pic sebebas yg kita mau, delete & add kl ada kesalahan,,
gmn ya bro?
soalnya untuk penginputan nama, alamat dsb (form registrasi yg sudah saya ceritain sblmnya) itu kan bisa sebebas kita kl salah pun bisa di ganti,,, nah kl picture ini gmn ya?

thanks,, mohon bantuannya.

wah, makasih banget mas..
tapi mas, kalo pas Insert Picture -> "Cancel" kok error ya?

error di :
myDoc.Shapes.AddPicture Filetoopen, False, True, alamatleft, alamattop, 100, 100

Halo Red dan Fabian..

Terima kasih mau mampir neh..

@Fabian: Supaya gak error, lihat code dibawah setelah filetoopen. Tambahan code ini supaya, kalo cancel, langsung exit.

@Red: silahkan ikuti code dibawah. Disini ada sedikit tricky ya. Dimana kita harus menyimpan nama picture di cell tempat kita meletakkan pic.

Berikut code-nya..

Sub insertpic()

'Deklarasi variabel untuk menampung nama file.
Dim Filetoopen

'Deklarasi variabel untuk meletakkan gambar pada posisi cell yang aktif.
Dim pic As Object, alamattop As Double, alamatleft As Double

'Menentukan alamat cell tempat menyimpan gambar
Alamatcell = "C3"

'menetukan posisi gambar dalam poin
alamattop = Range(Alamatcell).Top
alamatleft = Range(Alamatcell).Left

'Men-set variable myDoc sebagai holder Worksheets yang dipakai
'Ganti angka 1 sesuai dengan nama/nomor worksheets yang dipakai.
Set myDoc = Worksheets(1)

'Pastikan dokumen dalam kondisi ter-protect
'Menghilangkan proteksi dokument(sheet)
myDoc.Unprotect Password:=""

'memastikan apakah ada picture yang telah di insert.
'jika ada, maka akan dihapus
If Cells(3, 3) "" Then
namapic = Cells(3, 3).Value
ActiveSheet.Shapes(namapic).Select
Selection.Delete
Cells(3, 3).Value = ""
End If

'Memunculkan Dialog Window untuk memilih File Gambar. Hasilnya di berupa nama dan Path file dan disimpan di variabel Filetoopen.
'Tipe file yang bisa dibuka adalah JPG dan PNG. Tipe file ini bisa disesuaikan dengan kebutuhan.
Filetoopen = Application.GetOpenFilename("Picture File (*.jpg), *.jpg,(*.png), *.png", , "Insert Picture", , False)

'jika klik cancel maka keluar
If VarType(Filetoopen) = vbBoolean Then
Exit Sub
End If

'Men-set variabel pic menjadi holder Perintah untuk insert file.
'File yang diinsert sesuai dengan nama dan path file yang sebelumnya dipilih.
Set pic = ActiveSheet.Pictures.Insert(Filetoopen)

'buat nama picture
namapic = "picture1"
'menyimpan nama picture pada cell
'agar nantinya bisa dihapus pake VBA
Range(Alamatcell).Value = namapic

'Meng-insert gambar dan meletakkan gambar pada alamat yang aktif
With pic

'memberi nama picture yang diinsert
.Select
Selection.Name = namapic

'meletakkan posisi picture
.Top = alamattop
.Left = alamatleft

'mengatur ukuran picture
.ShapeRange.LockAspectRatio = msoFalse
.Height = 100
.Width = 100

End With

'mem-protect kembali dokumen
myDoc.Protect Password:=""

End Sub

------------

Oke, semoga sukses..

salam
Klinik Excel

bos mau tanya rumusnya insert gambar dengan pasta line?atas bantuannya saya ucapkan byk terima ksh

Mas Walijo,

Maksudnya pasta line apa ya?

salam

Kalau hasil insert fotony secara otomatis qt letakan simetris d tengah cell, tu gmn mas..??

trus bisa gk qt mnggunkan excel vb editor untk mengurangi kualitas foto (ukuran pixel ny)..??

mkasi,,