• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Klasörden resim alma

B

blue021433

Katılım
21 Şubat 2007
Mesajlar
24
Excel Vers. ve Dili
Office Professional Plus 2019 Türkçe
Arkadaşlar aşağıda ki kodla sadece b2 hücresine ID girince a2 hücresine resim getiriyor.
Benim yapmak istediğim b2:b1000 arası satırlara ID girince aynı şekilde a2:a1000 satırlarına resmi getirmek.
Yaptığım bazı değişikliklerle başarılı olamadım. Oluşan hatalar b3 hücresine veri girdiğimde b2 de ki görselin silinmesi gibi sonuçlar aldım.

Yardımlarınız için şimdiden teşekkür ederim.


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [b2]) Is Nothing Then Exit Sub
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Set fso = VBA.CreateObject("scripting.filesystemobject")
resimyolu = "C:\RESİM\" & Range("b2") & ".jpg"
resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"
If Not fso.fileexists(resimyolu) Then
Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
With Range("a2")
resimyok.Top = Range("a2").Top
resimyok.Left = Range("a2").Left
resimyok.ShapeRange.LockAspectRatio = msoFalse
resimyok.Height = 112
resimyok.Width = 84
End With
Else
Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
With Range("a2")
Resim.Top = Range("a2").Top
Resim.Left = Range("a2").Left
Resim.ShapeRange.LockAspectRatio = msoFalse
Resim.Height = 112
Resim.Width = 84
End With
End If
End Sub
 
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Son = 3
ReDim uzanti(Son)
uzanti(1) = ".bmp"
uzanti(2) = ".jpg"
uzanti(3) = ".gif"
 
 With Application
    .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With
ActiveSheet.DrawingObjects.Delete
Klasor = "C:\RESİM\"

Set fso = CreateObject("Scripting.FileSystemObject")
For i = 1 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, 1).Top + 2
    .Left = Cells(i, 1).Left + 2
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = Cells(i, 1).Height - 4
    .ShapeRange.Width = Cells(i, 1).Width - 4
End With
deg = 1
'Sheets("KONTROL").Range("a8").Select

Exit For
End If
Next
Next

End Sub
 
metin_0606' Alıntı:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Son = 3
ReDim uzanti(Son)
uzanti(1) = ".bmp"
uzanti(2) = ".jpg"
uzanti(3) = ".gif"

With Application
    .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With
ActiveSheet.DrawingObjects.Delete
Klasor = "C:\RESİM\"

Set fso = CreateObject("Scripting.FileSystemObject")
For i = 1 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, 1).Top + 2
    .Left = Cells(i, 1).Left + 2
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = Cells(i, 1).Height - 4
    .ShapeRange.Width = Cells(i, 1).Width - 4
End With
deg = 1
'Sheets("KONTROL").Range("a8").Select

Exit For
End If
Next
Next

End Sub
Genişletmek için tıkla ...

Metin bey çok teşekkür ederim bilginizi paylaştığınız için.
 
Konuyla ilgili alternatif bir kod çalışmasıda aşağıdadır.

Selamlar...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top = Range("A" & satır).Top + 5 Then
        If ActiveSheet.DrawingObjects(i).Left = Range("A" & satır).Left + 5 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If

    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Range("b2") & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
    
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84

Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub

hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
 
kulomer46' Alıntı:
Konuyla ilgili alternatif bir kod çalışmasıda aşağıdadır.

Selamlar...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top = Range("A" & satır).Top + 5 Then
        If ActiveSheet.DrawingObjects(i).Left = Range("A" & satır).Left + 5 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If

    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Range("b2") & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
   
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84

Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub

hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
Genişletmek için tıkla ...

Merhaba kulomer46,

Gönderdiğiniz kod ile a2 hücresine gelen ilk görsel diğer satırlara da aynısı gelmekte.
Örnek: b2 hücresine ID-1'e karşılık a2 hücresine 1.jpeg geliyor
b3 hücresine ID-2 yazdığımda a3 hücresine yine 1.jpeg gelmekte.
 
Merhaba

Bahsettiğiniz soruna neden olan kodlardaki hatayı düzelttim. Kodların son hali aşağıdadır.

resimyolu = "C:\RESİM\" & Range("b2") & ".jpg" satırını çıkartıp yerine
resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg" satırını ekledim

Selamlar...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

'ActiveSheet.DrawingObjects.Delete

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top = Range("A" & satır).Top + 5 Then
        If ActiveSheet.DrawingObjects(i).Left = Range("A" & satır).Left + 5 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If
  
    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
      
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84
  
Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub


hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
 
Son düzenleme:
kulomer46' Alıntı:
Merhaba

Bahsettiğiniz soruna neden olan kodlardaki hatayı düzelttim. Kodların son hali aşağıdadır.

Selamlar...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

'ActiveSheet.DrawingObjects.Delete

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top = Range("A" & satır).Top + 5 Then
        If ActiveSheet.DrawingObjects(i).Left = Range("A" & satır).Left + 5 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If
  
    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
      
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84
  
Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub


hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
Genişletmek için tıkla ...

Çok teşekkürler, Kod sorunsuz çalışmakta.
 
Merhaba

Kodların aşağıdaki son hali çıkabilecek bazı pürüzleri de engellemektedir.

Selamlar...


Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

'ActiveSheet.DrawingObjects.Delete

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top >= Range("A" & satır).Top + 4 And ActiveSheet.DrawingObjects(i).Top <= Range("A" & satır).Top + 6 Then
      If ActiveSheet.DrawingObjects(i).Left >= Range("A" & satır).Left + 4 And ActiveSheet.DrawingObjects(i).Left <= Range("A" & satır).Left + 6 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If
    
    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
      
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84
 
Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub


hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
 
kulomer46' Alıntı:
Merhaba

Kodların aşağıdaki son hali çıkabilecek bazı pürüzleri de engellemektedir.

Selamlar...


Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

'ActiveSheet.DrawingObjects.Delete

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top >= Range("A" & satır).Top + 4 And ActiveSheet.DrawingObjects(i).Top <= Range("A" & satır).Top + 6 Then
      If ActiveSheet.DrawingObjects(i).Left >= Range("A" & satır).Left + 4 And ActiveSheet.DrawingObjects(i).Left <= Range("A" & satır).Left + 6 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If
   
    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
     
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84

Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

Application.ScreenUpdating = True

Exit Sub


hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
Genişletmek için tıkla ...

Tekrardan teşekkürler, Gönderdiğiniz kodların son halini denedim sorunsuz çalışmakta.
 
kulomer46' Alıntı:
Kolay gelsin. Dönüş için teşekkürler.

Selamlar...
Genişletmek için tıkla ...
Sizden bir ricam daha olacak, bu kodlara ilaveten sayfa2 den veri çekebilir miyiz ? =düşeyara gibi.
Örnekleme verirsek; b2 hücresine ID verdiğim zaman a2 hücresine resim geliyordu, c,d,e ve f sütünlarına sayfa2 veri alma.
Sayfa2 a hücresinde ID yazmakta
sayfa2 b sütunu sayfa1 c ye gelecek
sayfa2 c sütunu sayfa1 d ye gelecek
sayfa2 d sütunu sayfa1 e ye gelecek
sayfa2 e sütunu sayfa1 f ye gelecek şekilde. :)
 
Merhaba

Talebinizi tam olarak anlayamadım.

Selamlar...
 
Merhaba,
Sizin vermiş olduğunuz kodlamada b2 hücresine ID yazdığım zaman o ID ye ait a2 hücresine resim gelmekte.
Aynı şekilde b2 hücresine yazdığım ID numarasına ait sayfa2 de veriler var onlarında gelmesini istiyorum.
 
blue021433' Alıntı:
Merhaba,
Sizin vermiş olduğunuz kodlamada b2 hücresine ID yazdığım zaman o ID ye ait a2 hücresine resim gelmekte.
Aynı şekilde b2 hücresine yazdığım ID numarasına ait sayfa2 de veriler var onlarında gelmesini istiyorum.
Genişletmek için tıkla ...

Merhaba

Yukardaki taleplerinizi karşılayan kodlar aşağıdadır.

Selamlar...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
'06.07.2020   11:11

On Error GoTo hata

Application.ScreenUpdating = False

If Intersect(Target, Cells(Target.Row, 2)) Is Nothing Then Exit Sub

'ActiveSheet.DrawingObjects.Delete

satır = Target.Row

uç1:
resimadedi = ActiveSheet.DrawingObjects.Count

For i = 1 To resimadedi

    If ActiveSheet.DrawingObjects(i).Top >= Range("A" & satır).Top + 4 And ActiveSheet.DrawingObjects(i).Top <= Range("A" & satır).Top + 6 Then
      If ActiveSheet.DrawingObjects(i).Left >= Range("A" & satır).Left + 4 And ActiveSheet.DrawingObjects(i).Left <= Range("A" & satır).Left + 6 Then

            ActiveSheet.DrawingObjects(i).Delete
            GoTo uç1

        End If
    End If
   
    DoEvents

Next

DoEvents

Set fso = VBA.CreateObject("scripting.filesystemobject")

resimyolu = "C:\RESİM\" & Cells(Target.Row, 2) & ".jpg"

resimsiz = "C:\RESİM\" & "RESİMSİZ.jpg"

Columns(2).HorizontalAlignment = xlCenter
Columns(2).VerticalAlignment = xlCenter
     
If Columns("A:A").EntireColumn.ColumnWidth < 22 Then Columns("A:A").EntireColumn.ColumnWidth = 22

If Not fso.FileExists(resimyolu) Then

    Set resimyok = ActiveSheet.Pictures.Insert(resimsiz)
        Range("A" & satır).EntireRow.RowHeight = 122
        resimyok.Top = Range("A" & satır).Top + 5
        resimyok.Left = Range("A" & satır).Left + 5
        resimyok.ShapeRange.LockAspectRatio = msoFalse
        resimyok.Height = 112
        resimyok.Width = 84

Else

    Set Resim = ActiveSheet.Pictures.Insert(resimyolu)
        Range("A" & satır).EntireRow.RowHeight = 122
        Resim.Top = Range("A" & satır).Top + 5
        Resim.Left = Range("A" & satır).Left + 5
        Resim.ShapeRange.LockAspectRatio = msoFalse
        Resim.Height = 112
        Resim.Width = 84

End If

        Target.Offset(0, 1) = ""
        Target.Offset(0, 2) = ""
        Target.Offset(0, 3) = ""
        Target.Offset(0, 4) = ""

For h = 1 To Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row

    If Target.Value = Sheets("Sayfa2").Cells(h, 1) Then
   
        Target.Offset(0, 1) = Sheets("Sayfa2").Cells(h, 2)
        Target.Offset(0, 2) = Sheets("Sayfa2").Cells(h, 3)
        Target.Offset(0, 3) = Sheets("Sayfa2").Cells(h, 4)
        Target.Offset(0, 4) = Sheets("Sayfa2").Cells(h, 5)
        GoTo bitti
   
    End If

Next

bitti:


Application.ScreenUpdating = True

Exit Sub


hata:

MsgBox "Bir Hata ile karşılaşıldı"
Exit Sub

End Sub
 
Merhaba,

Yine b2 hücresine veri girdiğimde sadece a2 hücresine resim gelmekte. sayfa2 den verileri almıyor. Belki de ben tam olarak anlatamadım.
Sayfa2 de A,B,C,D ve E sütunlarında ürün bilgilerim var.
Sayfa1 b2 hücresine veri girdiğimde sayfa2 b sütununda ki veri Sayfa1 c sütununa gelmesini sağlamak istiyorum.
Örnek dosya ektedir.
 

Ekli dosyalar

Merhaba

Dosyanızı indirdim ve inceledim.
Kodları eklediğim dosyanızın son hali Ek 'tedir.
Bende sorunsuz çalışıyor.

Selamlar...
 

Ekli dosyalar

Sorunu şimdi anladım,

Siz 2. sayfadan veri çekmeyi resim yolundan göstermişsiniz muhtemelen.
Bunu resimden değilde kod kısmından veri çekmeyi yapabilir miyiz ? Çünkü ürün görseli olmayan satırlarım var.
 
blue021433' Alıntı:
Sorunu şimdi anladım,

Siz 2. sayfadan veri çekmeyi resim yolundan göstermişsiniz muhtemelen.
Bunu resimden değilde kod kısmından veri çekmeyi yapabilir miyiz ? Çünkü ürün görseli olmayan satırlarım var.
Genişletmek için tıkla ...

Merhaba

Dosya bende düzgün çalışmaktadır. Şu andaki haliyle veri çekme kod kısmından yapılmaktadır.

selamlar...
 
Merhaba,

Evet ürün görseli varsa düzgün çalışıyor, fakat ürün görseli yoksa Bir Hata ile karşılaşıldı uyarısı verdiğinde ürün bilgileri gelmiyor.
Ürün görseli olmasa bile veriler gelsin olabilir mi.
Bunun çözümü var mıdır ?
Uğraştırdım size fazlasıyla :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst