Şimdi Ara

Excel'de Hücre açıklamasına eklenen resim ile alakalı soru

Daha Fazla
Bu Konudaki Kullanıcılar: Daha Az
2 Misafir - 2 Masaüstü
5 sn
3
Cevap
0
Favori
755
Tıklama
Daha Fazla
İstatistik
  • Konu İstatistikleri Yükleniyor
0 oy
Öne Çıkar
Sayfa: 1
Giriş
Mesaj
  • Şimdi ben hücrelere resim eklemek istiyorum. Kod olarak ;

     
    Option Explicit

    Sub AÇIKLAMAYA_RESİM_EKLE()
    Dim X As Long, AÇIKLAMA As Comment, DOSYA_YOLU As String
    Dim RESİM As Object, GENİŞLİK As Integer, YÜKSEKLİK As Integer

    Application.ScreenUpdating = False

    For X = 2 To Cells(Rows.Count, 1).End(3).Row
    If Cells(X, 1) <> "" Then
    DOSYA_YOLU = "C:\Users\emin\Desktop\Rehber\foto\" & Cells(X, 1) & ".jpg"

    Cells(X, 1).ClearComments
    Set AÇIKLAMA = Cells(X, 1).AddComment
    AÇIKLAMA.Text Text:=""

    If Dir(DOSYA_YOLU) <> "" Then
    Set RESİM = ActiveSheet.Pictures.Insert(DOSYA_YOLU)
    With RESİM
    GENİŞLİK = .Width
    YÜKSEKLİK = .Height
    .Delete
    End With

    With AÇIKLAMA.Shape
    .Fill.UserPicture DOSYA_YOLU
    .Width = GENİŞLİK
    .Height = YÜKSEKLİK
    End With

    Else

    With AÇIKLAMA
    .Text Text:=Chr(10) & Chr(10) & "RESİM BULUNAMADI !"
    .Shape.Fill.ForeColor.SchemeColor = 10
    .Shape.TextFrame.Characters.Font.Bold = True
    .Shape.TextFrame.Characters.Font.ColorIndex = 2
    End With

    End If
    End If
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End Sub



    bunu kullanıyorum. Fakat eklediğim resimler hep orjinal boyuttalar. Ben bunları tek tip boyutlamak istiyorum. Kodların neresinde oynama, ekleme, çıkartma yapmam lazım?







  • excelden anlayan kimse yok mu?
  • Çok basitmiş, fakat vb dilini bilmeyince olmuyor işte. Çözüm kırmızı olarak yazılmış yerde. Benim gibi yeni başlamış burada takılmış olan çıkarsa kodlar yardımcı olur inş.


    ....
    If Dir(DOSYA_YOLU) <> "" Then
    Set RESİM = ActiveSheet.Pictures.Insert(DOSYA_YOLU)
    With RESİM
    GENİŞLİK = 155.1
    YÜKSEKLİK = 155.1

    .Delete
    End With

    ....



    < Bu mesaj bu kişi tarafından değiştirildi memin05_06 -- 16 Aralık 2013; 10:36:30 >
  • 
Sayfa: 1
- x
Bildirim
mesajınız kopyalandı (ctrl+v) yapıştırmak istediğiniz yere yapıştırabilirsiniz.