- Katılım
- 22 Şubat 2023
- Mesajlar
- 227
- Excel Vers. ve Dili
- Türkçe
C2 satır ve sutunun genişliğine göre sutunun içerisine foto eklemek için tıklayınız ibaresini makro ile yapabilirmiyim yardımcı olurmusunz
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub ResimEkle()
Dim ws As Worksheet
Dim c2Genislik As Double
Dim c2Yukseklik As Double
Dim resimSol As Double
Dim resimUst As Double
Dim resim As Picture
' Çalışma sayfasını belirleyin
Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adınızı uygun şekilde değiştirin
' C2 hücresinin genişliğini ve yüksekliğini alın
c2Genislik = ws.Range("C2").Width
c2Yukseklik = ws.Range("C2").Height
' Resmin sol ve üst pozisyonunu belirleyin (örneğin, C2 hücresinin sol üst köşesi)
resimSol = ws.Range("C2").Left
resimUst = ws.Range("C2").Top
' Resmi ekleme
Set resim = ws.Pictures.Insert("C:\abc.jpg") ' Resim dosya yolunu uygun şekilde değiştirin
' Resmi boyutlandırma
With resim
.ShapeRange.LockAspectRatio = msoFalse
.Width = c2Genislik
.Height = c2Yukseklik
.Top = resimUst
.Left = resimSol
End With
End Sub
Set resim = ws.Pictures.Insert("C:\abc.jpg") ' Resim dosya yolunu uygun şekilde değiştirin
Sub ResimEkle()
Dim c2Genislik As Double
Dim c2Yukseklik As Double
Dim resimSol As Double
Dim resimUst As Double
Dim resim As Picture
Dim resimDosyasi As String
resimDosyasi = ResimDosyasiSec
If resimDosyasi = "" Then
MsgBox "Resim Dosyasi Seçilmedi....", vbCritical
Exit Sub
End If
c2Genislik = Range("C2").Width
c2Yukseklik = Range("C2").Height
' Resmin sol ve üst pozisyonunu belirleyin (örneğin, C2 hücresinin sol üst köşesi)
resimSol = Range("C2").Left
resimUst = Range("C2").Top
' Resmi ekleme
Set resim = ActiveSheet.Pictures.Insert(resimDosyasi) ' Resim dosya yolunu uygun şekilde değiştirin
' Resmi boyutlandırma
With resim
.ShapeRange.LockAspectRatio = msoFalse
.Width = c2Genislik
.Height = c2Yukseklik
.Top = resimUst
.Left = resimSol
End With
End Sub
Function ResimDosyasiSec() As String
Dim lngCount As Long
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False 'True
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 2
.Show
For lngCount = 1 To .SelectedItems.Count
ResimDosyasiSec = .SelectedItems(lngCount)
Next lngCount
End With
End Function