[Yardım]  HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#1)  KAFKAS35 » 24 Haz 2020 09:37

İyi çalışmalar yine bu formda yardımcı olan arkadaş sayesinde ekteki excelde resim getirme oluşturduk fakat hücre boyutuna göre resim ayarlanmıyor OTOMATİK BOYULANDIRMA olarak ayarlayabilirmiyiz hücrenin boyutuna göre resim otomatik boyutlandırılsın.
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#2)  KAFKAS35 » 24 Haz 2020 09:43

Private Sub Worksheet_Change(ByVal Target As Range)
son = 3
ReDim uzanti(son)
uzanti(1) = ".png"
uzanti(2) = ".jpg"
uzanti(3) = ".gif"

With Application
.DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With
Sheets("RESİMLİLİSTE").Pictures.Delete
Klasor = "E:\PAYLAŞIM\RESİMLER\"
Resim = "RESİM YOK"

Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Cells(Rows.Count, "B").End(3).Row
isim = Cells(i, 2).Value
deg = 0

For j = 1 To son
If fso.FileExists(Klasor & isim & uzanti(j)) = True Then
Set pc = ActiveSheet.Pictures.Insert(Klasor & isim & uzanti(j)) '<-- dikkat

With pc '<---
.Top = Cells(i, 5).Top + 2
.Left = Cells(i, 5).Left + 2
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height - 5
.ShapeRange.Width = Cells(i, 5).Width - 5

End With
deg = 1

Exit For
Else
If fso.FileExists(Klasor & Resim & uzanti(j)) = True Then
Set pc = ActiveSheet.Pictures.Insert(Klasor & Resim & uzanti(j)) '<-- dikkat

With pc '<---
.Top = Cells(i, 5).Top + 2
.Left = Cells(i, 5).Left + 2
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height - 5
.ShapeRange.Width = Cells(i, 5).Width - 5


End With
End If
End If
Next
Next
End Sub
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#3)  Miraç CAN » 25 Haz 2020 12:23

+2 ve -5'leri silin
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#4)  KAFKAS35 » 25 Haz 2020 14:45

Olmadı kardeşim..
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#5)  Miraç CAN » 25 Haz 2020 15:30

Olmayan ne?
En ve Boy mu?
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#6)  KAFKAS35 » 26 Haz 2020 06:35

Ben bı excelde 1500 yakın kişi resmi kullanıyorum hücreyi boyutlandırdıkça sıralamada kayıyor o zamanda isimle resim uyuşmuyor
Ben istiyorum ki hücre boyutunu nasıl ayarlarsam sıralama kaymadan resim hücreye göre boyutlasın hepsi bukadar
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#7)  Miraç CAN » 26 Haz 2020 07:13

Siz resimler eklendikten sonra ki değişikliklerden bahsediyorsunuz,
Mevcut kodlarınıza ekleyip dener misiniz?
.Placement = xlMoveAndSize
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#8)  KAFKAS35 » 26 Haz 2020 09:25

KARDEŞİM İLK ÖNCE İLGİLENDİĞİN İÇİN TEŞEKKÜREDERİM KODU EKLEDİM AMA BECEREMEDİM YUKARIDAKİ KODA GÖRE DÜZENLEMEN MÜMKÜNMÜ ACABA
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#9)  Miraç CAN » 26 Haz 2020 10:08

Deneyin:
Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
son = 3
ReDim uzanti(son)
uzanti(1) = ".png"
uzanti(2) = ".jpg"
uzanti(3) = ".gif"

With Application
    .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With
Sheets("RESİMLİLİSTE").Pictures.Delete
Klasor = "E:\PAYLAŞIM\RESİMLER\"
Resim = "RESİM YOK"

Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Cells(Rows.Count, "B").End(3).Row
    isim = Cells(i, 2).Value
    deg = 0
   
    For j = 1 To son
        If fso.FileExists(Klasor & isim & uzanti(j)) = True Then
            Set pc = ActiveSheet.Pictures.Insert(Klasor & isim & uzanti(j)) '<-- dikkat
            With pc '<---
                .Top = Cells(i, 5).Top + 2
                .Left = Cells(i, 5).Left + 2
                .ShapeRange.LockAspectRatio = msoFalse
                .Placement = xlMoveAndSize
                .ShapeRange.Height = Cells(i, 5).Height - 5
                .ShapeRange.Width = Cells(i, 5).Width - 5
            End With
            deg = 1
            Exit For
        Else
            If fso.FileExists(Klasor & Resim & uzanti(j)) = True Then
                Set pc = ActiveSheet.Pictures.Insert(Klasor & Resim & uzanti(j)) '<-- dikkat
                With pc '<---
                    .Top = Cells(i, 5).Top + 2
                    .Left = Cells(i, 5).Left + 2
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Placement = xlMoveAndSize
                    .ShapeRange.Height = Cells(i, 5).Height - 5
                    .ShapeRange.Width = Cells(i, 5).Width - 5
                End With
            End If
        End If
    Next j
Next i
End Sub
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#10)  KAFKAS35 » 26 Haz 2020 10:31

KARDEŞİM SAĞOL NE YAPTIKSA OLMADI BEN ŞÖYLE YAPTIM SÜTUN 30 SATIR 120 SABİTELDİM BU ŞEKİLDE KAYMA OLMUYOR ÖTEKİ BOYUTLANMALARIN HEPSİNDE KAYMA OLUYOR İLK 3-4 RESİMDEN SONRA KAYMA OLUYOR BU ŞEKİLDE SABİT KALACAK OLMAYINCA OLMUYOR EMEĞİNE SAĞLIK SAĞOL...
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#11)  Miraç CAN » 26 Haz 2020 12:11

Son eklediğimiz kod, hücrelerle taşı ve boyutlandırmayı aktif etmekti.
Fakat hücre yükseklik/genişliklerini değiştirdiğinizde, bu değerler mevcut resmin boyutlarından küçük ise küçültür, büyük ise sadece resmin ilk eklendiği ya da manuel olarak değiştirilen (resim özelliklerinde göreceğiniz değerler) boyutlarına kadar büyütür ve sadece sol ve üst köşeye taşır.

Aynı zamanda, hücre boyutları değiştiğinde tetiklenen bir olay var mı ben bilmiyorum, rastlamadım.

Ancak, resimleri sütun/satır sıralamasına uygun bir şekilde eklediğinizi varsayarak manuel çalıştırılan bir düzenleme makrosu yazabiliriz.

Kodlarınızdan anlayabildiğime göre, eklenecek resim isimlerini "B" sütunundan satır sırasına göre alıp, "E" sütunu satırlarına sırasıyla ekliyor.
Eğer çalışma prensibiniz bu şekilde ise, deneyin:
Kod: Tümünü seç
Sub ReSize()
Dim Resim As Object, i%: i = 1
For Each Resim In ActiveSheet.Shapes
    If Resim.Type = 13 Then
        i = i + 1
        With Resim
            .LockAspectRatio = msoFalse
            .Placement = xlMoveAndSize
            .Top = Cells(i, 5).Top + 2
            .Left = Cells(i, 5).Left + 2
            .Height = Cells(i, 5).Height - 4
            .Width = Cells(i, 5).Width - 4
        End With
    End If
Next Resim
End Sub
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 543
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya\Adana

Cevap: HÜCRE İÇERİSİNE RESİMLERİ OTOMATİK BOYUTLANDIRMA

İleti#12)  KAFKAS35 » 26 Haz 2020 15:48

herşey için teşeükkür ederim çok sağol ben çözümü anlattığım şekilde çözdüm iyi günler kardeşim
Kullanıcı avatarı
KAFKAS35
Yeni Başlamış
 
Kayıt: 24 May 2020 14:50
Meslek: memur
Yaş: 36
İleti: 30
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 3 misafir

Bumerang - Yazarkafe