Kullanıcıdan Resim Almak İçin Gözat Penceresi Oluşturma????

Katılım
22 Mart 2006
Mesajlar
4
Kullanıcıdan resim almak için bir buton oluşturdum sheet 1 de.Gözat penceresinden alınacak resim boyutları 400*300 jpg.Bu resmi sheet2 de belirlediğim bir hücre aralığı içerisine range etmek istiyorum.Buraya kadar bir şey yok yanlız gözat penceresinin kodunu yazmak için herhangi bir bilgim yok yardımcı olursanız sevinirim arkadaşlar.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki kodları deneyin.

[vb:1:2f03aa5c79]Dosya = Application.GetOpenFilename("Jpg resimleri,*.jpg)")
If Dosya = False Then Exit Sub
MsgBox Dosya
[/vb:1:2f03aa5c79]
 
Katılım
22 Mart 2006
Mesajlar
4
hocam saolasın beni büyük bir dertten kurtardın :) çok teşekkür ederim çalışmalarınızın devamı dilerim.
 
Katılım
22 Mart 2006
Mesajlar
4
biraz fazla heyecan yaptım sanırsam :D önerdiğiniz komutu
2. satırdan sonra yerleştirdim fakat resmi range etmiyor.
bu kodu ben yazmadım çünkü bu dil hakkında pek bir bilgim yok başka bir öneriniz var mı?



Sub fotoekle7()


'
' fotoekle Makro
'
'

'
Sheets("FORM").Select
Range("G46:J56").Select
ActiveSheet.Pictures.Insert("c:\001.jpg ").Select
ActiveWindow.SmallScroll Down:=6
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 243
Selection.ShapeRange.Width = 183
Range("G466:J56").Select
ActiveWindow.SmallScroll Down:=5
Sheets("SIP").Select
Range("B2").Select
End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki gibi deneyin.

[vb:1:79f6d3720a]Sub fotoekle7()

Sheets("FORM").Select
Range("G46:J56").Select

Dosya = Application.GetOpenFilename("Jpg resimleri,*.jpg)")
If Dosya = False Then Exit Sub
ActiveSheet.Pictures.Insert(dosya).Select

ActiveWindow.SmallScroll Down:=6
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 243
Selection.ShapeRange.Width = 183
Range("G466:J56").Select
ActiveWindow.SmallScroll Down:=5
Sheets("SIP").Select
Range("B2").Select
End Sub [/vb:1:79f6d3720a]
 
Katılım
22 Mart 2006
Mesajlar
4
levent bey çok teşekkürler hayırlı geceler..
 
Üst