- Katılım
- 4 Mayıs 2020
- Mesajlar
- 49
- Excel Vers. ve Dili
- Excel 2016 Türkçe
- Altın Üyelik Bitiş Tarihi
- 25-07-2023
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("LİSTE").Pictures.Delete
Klasor = "D:\PAYLAŞIM\RESİMLER1\"
Resim = "RESİM YOK"
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Cells(Rows.Count, "A").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
.Left = Cells(i, 5).Left
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height
.ShapeRange.Width = Cells(i, 5).Width
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
.Left = Cells(i, 5).Left
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height
.ShapeRange.Width = Cells(i, 5).Width
End With
End If
End If
Next
Next
End Sub
Merhabalar bu formül ile isme göre E sütununa resimler geliyor ben G sütununa gelmesini istiyorum nasıl değişiklik yapabilirim
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("LİSTE").Pictures.Delete
Klasor = "D:\PAYLAŞIM\RESİMLER1\"
Resim = "RESİM YOK"
Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Cells(Rows.Count, "A").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
.Left = Cells(i, 5).Left
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height
.ShapeRange.Width = Cells(i, 5).Width
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
.Left = Cells(i, 5).Left
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Cells(i, 5).Height
.ShapeRange.Width = Cells(i, 5).Width
End With
End If
End If
Next
Next
End Sub
Merhabalar bu formül ile isme göre E sütununa resimler geliyor ben G sütununa gelmesini istiyorum nasıl değişiklik yapabilirim