resim çağırma

[yigitcanov]

ekte bulunan dosyada ilgili sıkıntılarım yazmaktadır. ilgilenebilirseniz sevinirim

 

[Ömer BARAN]

Merhaba.

Ekli belgede istediğinize yakın birşeyler yaptım.

Belgeyi açtığınızda makroları etkinleştirin ve sayfadaki açıklamayı okuyun.
Resimlerin bulunduğu dizine ilişkin kod satırı:
Klasor = "C:\resim" & "\" & Cells(sat + 1, sut).Value & ".jpg"

Gerekirse, resimleri boyutlandırma durumu için forumda arama yapın,
halledemezseniz yeni konu açarak veya bu konu sayfasında tekrar destek isteyin.
.

 

[yigitcanov]

Merhaba.

Ekli belgede istediğinize yakın birşeyler yaptım.

Belgeyi açtığınızda makroları etkinleştirin ve sayfadaki açıklamayı okuyun.
Resimlerin bulunduğu dizine ilişkin kod satırı:
Klasor = "C:\resim" & "\" & Cells(sat + 1, sut).Value & ".jpg"

Gerekirse, resimleri boyutlandırma durumu için forumda arama yapın,
halledemezseniz yeni konu açarak veya bu konu sayfasında tekrar destek isteyin.
.

kardeşim sadece resim boyutlandırmada sıkıntı yaşıyorum. sitede bişiler buldum ama 2007 tarihli olduğu için dosyaya erişilemiyor. resimlerim 160*240 piksel. excel hücrelerini de öyle yaptım ama resimler çok küçük çıkıyor. kataloğun son hali ektedir

 

[Ömer BARAN]

Tekrar merhaba.

Mevcut koddaki aşağıdaki kısmı değiştirerek tekrar dener misiniz?
Bu sayılarda değişiklik yaparak sonuca ulaşmanız lazım.
Ayrıca kullanışlılık bakımından, yükseklik/genişlik olayını hallettikten sonra,
en alttaki MsgBox "İŞLEM TAMAM" satırını da silersiniz.
.

[FONT="Arial Narrow"]With Cells(sat, sut)
................gen = [COLOR="Red"]100[/COLOR]: yuk = [COLOR="red"]172[/COLOR]
End With[/FONT]

Ya da bu şekilde net sayılar yerine aşağıdaki gibi oranlar kullanabilirsiniz (dikkat:virgül yerine nokta).
.

[FONT="Arial Narrow"]With Cells(sat, sut)
................gen = [COLOR="Red"]Cells(sat, sut).Width * 0.92[/COLOR]: yuk = [COLOR="red"]Cells(sat, sut).Height * 0.92[/COLOR]
End With[/FONT]

 

[yigitcanov]

bunları nereye kopyalayacağımı bulamadım vba da

 

[Ömer BARAN]

Tekrar merhaba.

Benim denemelerimde sorun yok.
Sizin son eklediğiniz belgedeki kodların tümünü silin yerine aşağıdaki kodları yapıştırın.
(kodlar, alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan ekranın sağ tarafında)
.

[FONT="Arial Narrow"][B][COLOR="Blue"]Sub KATALOG()[/COLOR][/B]
Dim resim As Object
ActiveSheet.Calculate
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For nesne = ActiveSheet.Shapes.Count To 1 Step -1
    If ActiveSheet.Shapes.Range(Array(nesne)).Name = "Değer Değiştirici 1" Then GoTo 20
        With ActiveSheet.Shapes.Range(Array(nesne))
            .Select: .Delete
        End With
20: Next
If ActiveSheet.Cells(3, "K") = 0 Then GoTo 10
For sat = 2 To 11 Step 3
    For sut = 2 To 8 Step 2
        Klasor = "C:\resim" & "\" & Cells(sat + 1, sut).Value & ".jpg"
        If Dir(Klasor) = "" Then GoTo 50
        Set res = ActiveSheet.Pictures.Insert(Klasor)
            With res
                .ShapeRange.LockAspectRatio = msoFalse: .Placement = xlMoveAndSize
                .Top = Cells(sat, sut).Top + 2: .Left = Cells(sat, sut).Left + 2
                .Width = Cells(sat, sut).Width * 0.96: .Height = Cells(sat, sut).Height * 0.98
            End With
50:        Set res = Nothing
    Next
Next
10: [K2].Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]