Dosya içindeki Teklif Formu sayfasını Yeni Kitap olarak kaydetme

[Mdemir63]

Selamlar

Ekteki örnek dosya içerisindeki Teklif Formu sayfasını yeni bir dosya yapmak ve yeni yaptığımız dosyada buton ve düğmeleri kaldırmak istiyorum. Makro yöntemiyle nasıl yapılabilir?

Saygılar

 

[Mdemir63]

Arkadaşlar,
Kayıt makro mantığı ile yapmaya çalıştım ancak, olmadı Combobox ve Buton u silme de hatalar veriyor. İlgilenebilir seniz çok memnun olurum.

Saygılar

 

[Mdemir63]

Selamlar

Arkadaşlar fikri olan yok mu?

Saygılar

 

[YUSUF44]

Sizin dosyanıza nasıl uyarlanır bilmiyorum. Ancak daha önce kullanmış olduğum bir makro sayfadaki kod ve nesneleri siliyordu. Kod şu şekilde:

Sub frk_kaydet()

yol = ThisWorkbook.Path & "\" & [a2].Text & " " & [c1].Text & ".xlsx"
If CreateObject("Scripting.FileSystemObject").FileExists(yol) = True Then
MsgBox "Bu isimde bir dosya zaten mevcut. Kayıt yapılmayacak.", vbCritical, "UYARI"
Exit Sub
End If
Sayfa_Adı = ActiveSheet.Name
ThisWorkbook.Worksheets.Select
ThisWorkbook.Worksheets.Copy
ActiveWorkbook.SaveAs Filename:=yol
 
For i = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(i).DrawingObjects.Delete
Next i
 
ActiveWorkbook.Save
ActiveWindow.Close
Sheets(Sayfa_Adı).Select
Range("C2").Select
MsgBox "işlem tamam"
End Sub

 

[Mdemir63]

Selamlar
Hocam bende uygulayamadım

Saygılar

 

[YUSUF44]

İşinizi görür mü bilmiyorum. aşağıdaki kodları deneyiniz:

Sub frk_kaydet()
tarih = WorksheetFunction.Text([H1], "yyyy mm dd")
yol = ThisWorkbook.Path & "\" & tarih & " " & [D4].Text & ".xlsx"
If CreateObject("Scripting.FileSystemObject").FileExists(yol) = True Then
MsgBox "Bu isimde bir dosya zaten mevcut. Kayıt yapılmayacak.", vbCritical, "UYARI"
Exit Sub
End If
Application.DisplayAlerts = False
Sayfa_Adı = ActiveSheet.Name
ThisWorkbook.ActiveSheet.Select
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=yol
 
For i = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(i).DrawingObjects.Delete
Next i
ActiveWorkbook.ActiveSheet.[H1] = ActiveWorkbook.ActiveSheet.[H1].Value
ActiveWorkbook.ActiveSheet.[H2] = ActiveWorkbook.ActiveSheet.[H2].Value
ActiveWorkbook.ActiveSheet.[H4] = ActiveWorkbook.ActiveSheet.[H4].Value
ActiveWorkbook.ActiveSheet.[H5] = ActiveWorkbook.ActiveSheet.[H5].Value
ActiveWorkbook.ActiveSheet.[H6] = ActiveWorkbook.ActiveSheet.[H6].Value
ActiveWorkbook.ActiveSheet.[H7] = ActiveWorkbook.ActiveSheet.[H7].Value
ActiveWorkbook.ActiveSheet.[E5] = ActiveWorkbook.ActiveSheet.[E5].Value
ActiveWorkbook.Save
ActiveWindow.Close
Sheets(Sayfa_Adı).Select
Application.DisplayAlerts = True
Range("C2").Select
MsgBox "işlem tamam"
End Sub

Bu arada muhtemelen kodları daha önce bu siteden bulmuştum.

 

[Mdemir63]

Teşekkürler hocam deneyeceğim

 

[Mdemir63]

Selamlar
Hocam ikinci verdiğiniz kodlar işimi gördü. Teşekkür ederim. Ancak Bizim bu form üzerinde normalde A1 hücresinin büyüklüğünde resim olarak firmanın amblemi ve en alt onay bolümünde yine resim olarak kaşemizin resimleri var bunlar oluşturduğumuz dosyada siliniyor . Bunu nasıl önleyebiliriz?

Saygılar

 

[YUSUF44]

Dosyada o resimler varken eklerseniz resmin adına göre düzeltme yapılabilir muhtemelen.

 

[Mdemir63]

Selamlar

Hocam Resimli halini tekrar yüklüyorum.

Saygılar

 

[YUSUF44]

Ben yapamadım maalesef. Tecrübeli arkadaşlar ilgilenir inşallah.

 

[Mdemir63]

Yusuf hocam
ilginize teşekkür ederim.
Umarım üstadlar ilgilenirler.

Saygılar

 

[Mdemir63]

Selamlar
Hocam bir çözüm bulabilir miyiz?

Saygılar

 

[Mdemir63]

Selamlar

Arkadaşlar mümkün değil mi acaba?

Saygılar