resim ekleme ve otomatik sığdırma

Katılım
2 Şubat 2012
Mesajlar
3
Excel Vers. ve Dili
2011 türkçe
merhaba arkadaşlar

işyerinde numune resimlerini hücreye otomaik sıgdırmak istiyorum. yardımcı olabilirseniz çok sevinirim
 

mest3651

Altın Üye
Katılım
5 Ocak 2006
Mesajlar
186
Altın Üyelik Bitiş Tarihi
07-08-2027
tam olarak yapmak istediğin şeyi dosya eklersen açıklamasını orda yapsan daha çabuk cevap alırsın.
 
Katılım
2 Şubat 2012
Mesajlar
3
Excel Vers. ve Dili
2011 türkçe
Otomatik sıgdırma

Arkadaşlar dosyayı ekledim. Yardımcı olabilirseniz çok sevinirimn
 

Ekli dosyalar

Katılım
2 Şubat 2012
Mesajlar
3
Excel Vers. ve Dili
2011 türkçe
Arkadaşlar lütfen yardım

Yeni dosya ekledim. Arkadaşlar işyerinde sıkıntıya düştüm . Lütfen yardımcı olabilecek varsa çok sevinirim. Detaylı bi anlatıma ihtiyacım var.
 

Ekli dosyalar

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,211
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Detaylı anlatımları syn. hamitcan'ın verdiği linklerde bulabilirsin.
Öncelikle C sürücüsünde resim isminde bir klasör açın ve .jpg uzantılı resimlerinizi buraya yerleştirin.
Daha sonra excel dosyasını açın. excel dosyasında herhangi bir işlem makroyu tetikleyecek ve resimler yenilenecektir. excel sayfasında iken ALT+F11 tuşlarına basarak makro kısmına geçin.
İlk resmi (A1 hücresine) getiren makro aşağıdadır.

Range("A1").Select
resimadi = LoadPicture("")
resimadi = Range("B1").Text & ".jpg"
On Error Resume Next
ActiveSheet.Pictures.Insert("C:\resim\" & resimadi).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 55
Selection.ShapeRange.Width = 48
Selection.ShapeRange.Rotation = 0#

Burda ilk satırda A1 resim alınacak alan,
üçüncü satırdaki B1 ise alınacak resmin adının alındığı adrestir.
7. satırdaki 55 değeri ve altındaki 48 değeri resmin boyutlarını belirler.
Bu bilgiler ışığında yukardaki kodları çoğaltarak ve A1 - B1 değerlerini değiştirerek tablonuzu düzenleyebilirsiniz.

İyi çalışmalar.

Not: Kodlar alıntıdır.
 

Ekli dosyalar

Katılım
31 Temmuz 2008
Mesajlar
93
Excel Vers. ve Dili
2003
Aşağıda seçilen hücreye göre resmi otomatik boyutlandıran makroyu bulabilirsiniz.

Sub InsertionImage()
Dim Emplacement As Range
Dim Img As Variant
Dim XRatio As Double
Dim YRatio As Double
Dim adr As String

adr = Selection.Address

If Application.Dialogs(xlDialogInsertPicture).Show Then
Set Emplacement = ActiveCell
Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

XRatio = Range(adr).Width / Img.Width
YRatio = Range(adr).Height / Img.Height

With Img
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveCell.Left + 1
.Top = ActiveCell.Top + 1
.Placement = xlMoveAndSize
End With

If (XRatio < YRatio) Then
Img.Width = (Img.Width * XRatio) - 1
Img.Height = (Img.Height * XRatio) - 1
Else
Img.Width = (Img.Width * YRatio) - 1
Img.Height = (Img.Height * YRatio) - 1
End If

If (Img.Width < Range(adr).Width) Then
Img.Left = Range(adr).Left + 1 + ((Range(adr).Width - Img.Width) / 2)
End If
End If
End Sub
 
Üst