Klasörden eklediğim resmi klasörden silmek

[bmutlu966]

Ekteki dosya ile bir klasörden excel sayfasına resim ekliyorum. Resmi excel sayfasına eklediğimde, eklediğim klasörden de silinsin istiyorum. Kodlara nasıl bir ilave yapmam gerekiyor yardımcı olursanız sevinirim?

 

[TanerSaydam]

Dosyayı indiremiyorum ama anladığım kadarıyla izleyeceğiniz yolu anlatayım.

Öncelikle dosyayı aldığınız klasör adı ve dosya adını bir hücreye yazdırın.

Sonra o hücreyi değer alarak sil makrosu yazın.

Örn:

Kill "C:\1\a.jpeg"

 

[halit3]

Kod

Sub InsertPicture()
Dim sPicture As String, pic As Picture

Range("B2").Select

sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
, "Faturayı seçiniz.")
MsgBox sPicture

If Val(Len(sPicture)) = [COLOR="Red"]5[/COLOR] Then Exit Sub


Adres = ActiveWindow.RangeSelection.Address

Dim Resim As Object
    
    For Each Resim In ActiveSheet.Shapes
        If TypeName(ActiveSheet.Shapes(Resim.Name).OLEFormat.Object) = "Picture" Then
            Resim.Delete
        End If
    Next

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic

.ShapeRange.LockAspectRatio = msoFalse
.Height = Range(Adres).Height - 4
.Width = Range(Adres).Width - 4
.Top = Range(Adres).Top + 2
.Left = Range(Adres).Left + 2
.Placement = xlMoveAndSize
End With


[COLOR="Red"]Dim fl As Object
Set fl = CreateObject("Scripting.FileSystemObject")

If CreateObject("Scripting.FileSystemObject").FileExists(sPicture) = True Then
fl.DeleteFile sPicture
End If[/COLOR]


Set pic = Nothing

End Sub

 

[bmutlu966]

Arkadaşlar ilginiz için çok teşekkürler.

Halit hocam yazdığınız kod sorunsuz çalıştı. Bir problemim daha var.
Resim seçmek için açılan pencerede resim eklemekten vazgeçip iptal tuşuna bastığımda aşağıdaki satırda hata veriyor. Bu hatayı nasıl geçebilirim?

Set pic = ActiveSheet.Pictures.Insert(sPicture)

 

[bmutlu966]

On Error Resume Next ile hallettim. Teşekkürler.

 

[halit3]

3 nolu mesajdaki kodu düzelttim
kırmızı bölümü 0 yerine 5 yapın

If Val(Len(sPicture)) = 0 Then Exit Sub

If Val(Len(sPicture)) =[COLOR="Red"] 5 [/COLOR]Then Exit Sub

ayrıca farklı bir yöntem ile yazılmış kod

Sub resimgetir()

yol = "c:\" 'ActiveWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear

.Filters.Add "Gif Dosyalar", "*.gif", 1
.Filters.Add "Jepeg Dosyalar", "*.jpg", 1
.Filters.Add "Bmp Dosyalar", "*.bmp", 1
.Filters.Add "Tif Dosyalar", "*.tif", 1
.Filters.Add "Tüm Dosyalar", "*.*", 1
.InitialFileName = yol
.Show
'.Execute
If .SelectedItems.Count = 0 Then GoTo 1
sPicture = .SelectedItems(1)
MsgBox .SelectedItems(1)


Adres = ActiveWindow.RangeSelection.Address

Dim Resim As Object

For Each Resim In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Resim.Name).OLEFormat.Object) = "Picture" Then
Resim.Delete
End If
Next

Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic

.ShapeRange.LockAspectRatio = msoFalse
.Height = Range(Adres).Height - 4
.Width = Range(Adres).Width - 4
.Top = Range(Adres).Top + 2
.Left = Range(Adres).Left + 2
.Placement = xlMoveAndSize
End With

Dim fl As Object
Set fl = CreateObject("Scripting.FileSystemObject")

If CreateObject("Scripting.FileSystemObject").FileExists(sPicture) = True Then
fl.DeleteFile sPicture
End If


Set pic = Nothing

1
End With
End Sub

 

[bmutlu966]

Halit hocam düzenlemeyi yaptım çok teşekkürler. Bir de şöyle bir ihtiyaç doğdu.

Eğer sayfada bir resim yok ise işlem yapma gibi bir koda ihtiyacım var.