Farklı Kaydet yapılan dosyada işlem yapma

[tamer42]

Merhaba,
Ekli dosyayı aşağıdaki kod ile "Farklı Kaydet" yaptıktan sonra yeni dosyada en soldaki "Yeni Teklif" yazan butonun silinmesini nasıl sağlanabili?

Orjinal dosyada bu buton kalacak, yeni kaydedilen dosyada bu buton olmayacak.

Nasıl bir kod düzenlemesi yapılması gerekir?

Teşekkürler,

Sub Save_file()
Dim path As String
Dim filename1 As String
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Format")

path = ThisWorkbook.path

filename1 = ws.Range("D5").Text

ThisWorkbook.SaveAs Filename:=(path & "\" & filename1 & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

 

[Necdet]

Merhaba,

Sub Save_file()

Dim path As String
Dim filename1 As String
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Format")

path = ThisWorkbook.path

filename1 = ws.Range("D5").Text

ThisWorkbook.SaveAs Filename:=(path & "\" & filename1 & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

ActiveSheet.Shapes("Düğme 7").Delete

End Sub

 

[tamer42]

Merhaba,

Sub Save_file()

Dim path As String
Dim filename1 As String
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Format")

path = ThisWorkbook.path

filename1 = ws.Range("D5").Text

ThisWorkbook.SaveAs Filename:=(path & "\" & filename1 & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled

ActiveSheet.Shapes("Düğme 7").Delete

End Sub

Necdet Hocam çok teşekkürler,
ActiveSheet.Shapes("Düğme 7").Delete
satırında bazı durumlarda Bu öğe bulunmadı diye hata veriyor.
kesin olması açısından üzerinde yazan metine göre aşağıdaki gibi düzenlemek istersek,
bu seferde ekli hata mesajını alıyorum

For Each shp In ActiveSheet.Shapes

If shp.TextFrame.Characters.Text Like "Yeni Teklif" Then
    shp.Delete
End If
 
Next shp

 

[Necdet]

Merhaba,
Sonuçta olmadığında hata versin istemiyorsanız delete ten 1 satır önce on error resume next deyin, bence yeterli olacaktır.

 

[Korhan Ayhan]

Nesne tipini kontrol ederek işlem yapabilirsiniz.

Sub Save_file()
    Dim path As String
    Dim filename1 As String
    Dim ws As Worksheet
    Dim Shp As Shape
   
    Set ws = ThisWorkbook.Sheets("Format")
   
    path = ThisWorkbook.path
   
    filename1 = ws.Range("D5").Text
   
    Stop
   
    ThisWorkbook.SaveAs Filename:=(path & "\" & filename1 & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
   
    For Each Shp In ActiveSheet.Shapes
        If Shp.Type = 8 Then
            If InStr(1, Shp.TextFrame.Characters.Text, "Yeni Teklif") > 0 Then Shp.Delete
        End If
    Next
    
    ActiveWorkbook.Save
End Sub

 

[tamer42]

Nesne tipini kontrol ederek işlem yapabilirsiniz.

Sub Save_file()
    Dim path As String
    Dim filename1 As String
    Dim ws As Worksheet
    Dim Shp As Shape
  
    Set ws = ThisWorkbook.Sheets("Format")
  
    path = ThisWorkbook.path
  
    filename1 = ws.Range("D5").Text
  
    Stop
  
    ThisWorkbook.SaveAs Filename:=(path & "\" & filename1 & ".xlsm"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
  
    For Each Shp In ActiveSheet.Shapes
        If Shp.Type = 8 Then
            If InStr(1, Shp.TextFrame.Characters.Text, "Yeni Teklif") > 0 Then Shp.Delete
        End If
    Next
   
    ActiveWorkbook.Save
End Sub

Çık teşekkürler Necdet Hocam