Dosyadan kişi kartı oluşturma

[massgrave]

UserForm1'de bulunan TextBoxlardaki verilerin ekte göndermiş olduğum formatta PDF olarak görüntüleyip yazdırmak istiyorum. Yardımcı olursanız memnun olurum.

Kendi çapımda birşeyler çıkardım. Pdf olarak beceremedim ama excel olarak birşeyler denedim fakat bir sorun meydana geliyor.Oda şuki: Ayrı pencerede açıyor ayarladğım şekilde çıkıyor ok sorun yok fakat açılan excel sayfasını kapattığım zaman kaydet kaydetme diye soruyor kaydetme diyorum Run-Time error (Method Save of object _Workbook failed hatası veriyor ve kullanmıs oldugum programda kapanıyor. Ne yapmalıyım?

Ayrıca bu dosyayı pdf olarak ' Sheets(1).Range("C7") = TextBox4.Value ' değerine verilen isimle PDF olarak kaydetmek istiyorum.
Karşıma excel sayfası değilde convert edilen PDF sayfası gelsin hem yazdır hazır ekranı ile yazdırabilsin hemde PDF olarak kayıt yapabilsin. Yeni açılan excel sayfasıyla alakalı hiçbirşey görünmesin. En alttaki kod ile PDF çevirebildim ama istediğim şekilde olmadı.

Private Sub VcardYaz_Click()
Workbooks.Add
On Error Resume Next
Sheets(1).Range("B3,B5,B7,B8,B9,B10,B11,B13,D5,D7,D8,B12,D9,D10").Font.ColorIndex = 56 'başlık yazı rengi
On Error Resume Next
Sheets(1).Range("B3,B5,B7,B8,B9,B10,B11,B13,D5,D7,D8,B12,D9,D10").Interior.ColorIndex = 35 ' başlık arkaplan
On Error Resume Next
Sheets(1).Range("B3,B5,B7,B8,B9,B10,B11,B13,D5,D7,D8,B12,D9,D10").Font.ColorIndex = 56 'başlık yazı rengi
On Error Resume Next
Sheets(1).Range("B3,B5,B7,B8,B9,B10,B11,B13,D5,D7,D8,B12,D9,D10").Font.Bold = True
On Error Resume Next
Sheets(1).Range("B5,B7,B8,B9,B10,B11,B13,D5,D7,D8,B12,D9,D10").Font.Size = 15
On Error Resume Next
Sheets(1).Range("B3:E3").Merge
Sheets(1).Range("B4:E4").Merge
Sheets(1).Range("B6:E6").Merge
Sheets(1).Range("D10:D13").Merge
Sheets(1).Range("E10:E13").Merge
Sheets(1).Range("D7:D8").Merge
Sheets(1).Range("E7:E8").Merge
Sheets(1).Range("B3:B4").Merge

Sheets(1).Range("B3") = "BAŞLIK YAZISI"
Sheets(1).Range("B3").Font.Size = 27

Sheets(1).Range("B5") = "D.SIRANO"
Sheets(1).Range("C5") = TextBox1.Value
Sheets(1).Range("C5").Font.Bold = True
Sheets(1).Range("C5").Font.Size = 25

Sheets(1).Range("D5") = "ARŞİV Mİ"
Sheets(1).Range("E5") = TextBox2.Value
Sheets(1).Range("E5").Font.Bold = True
Sheets(1).Range("E5").Font.Size = 25

Sheets(1).Range("B7") = "KİŞİ 1"
Sheets(1).Range("C7") = TextBox4.Value

Sheets(1).Range("B8") = "NO"
Sheets(1).Range("C8") = TextBox3.Value

Sheets(1).Range("B9") = "İL"
Sheets(1).Range("C9") = TextBox6.Value

Sheets(1).Range("B10") = "DENEME"
Sheets(1).Range("C10") = TextBox7.Value

Sheets(1).Range("B11") = "KARSI DENEME"
Sheets(1).Range("C11") = TextBox5.Value

Sheets(1).Range("B12") = "DURUM"
Sheets(1).Range("C12") = TextBox8.Value

Sheets(1).Range("B13") = "KİŞİ 2"
Sheets(1).Range("C13") = TextBox9.Value

Sheets(1).Range("D10") = "NOT"
Sheets(1).Range("E10") = TextBox10.Value

Sheets(1).Range("D7") = "ADRES"
Sheets(1).Range("E7") = TextBox11.Value

Sheets(1).Range("D9") = "TELEFON"
Sheets(1).Range("E9") = TextBox12.Value

Sheets(1).Columns("B").ColumnWidth = 20
Sheets(1).Columns("D").ColumnWidth = 20

Sheets(1).Columns("C").ColumnWidth = 45
Sheets(1).Columns("E").ColumnWidth = 45
    
Sheets(1).UsedRange.RowHeight = 20 'satır yükseliği
On Error Resume Next
'Sheets(1).UsedRange.ColumnWidth = 18 'sütun genişliğini elle vermek isterseniz
'On Error Resume Next
'Sheets(1).UsedRange.Columns.AutoFit 'otomatik sütun genişliği
'On Error Resume Next
Sheets(1).UsedRange.HorizontalAlignment = xlCenter 'dikey yerleşim ortala
On Error Resume Next
Sheets(1).UsedRange.VerticalAlignment = xlVAlignCenter ' yatay yerleşim ortala
On Error Resume Next
Sheets(1).UsedRange.WrapText = False 'metni kaydırma
On Error Resume Next
Sheets(1).UsedRange.ShrinkToFit = True 'uyacak şekilde daralt
On Error Resume Next
Sheets(1).UsedRange.Borders.LineStyle = xlContinuous 'tablo çizgisi ekle
On Error Resume Next
Sheets(1).UsedRange.Borders.ColorIndex = 56 'tablo çizgisi rengi
On Error Resume Next
Sheets(1).UsedRange.Borders.Weight = xlThin 'tablo çizgi kalınlığı
On Error Resume Next
Sheets(1).PageSetup.Orientation = xlLandscape 'yatay yerleşim
On Error Resume Next
Sheets(1).PageSetup.LeftMargin = 2 'soldan pay
On Error Resume Next
Sheets(1).PageSetup.RightMargin = 2 'sağdan pay
On Error Resume Next
Sheets(1).PageSetup.TopMargin = 5 'üstten pay pay
On Error Resume Next
Sheets(1).PageSetup.FooterMargin = 5 'alttan pay pay
On Error Resume Next
Sheets(1).Cells.HorizontalAlignment = xlLeft 'sola yaslar
On Error Resume Next
Sheets(1).Range("B3").HorizontalAlignment = xlCenter 'başlığı ortalar
On Error Resume Next
'Sheets(1).PageSetup.PrintArea = "$B$1:$E$10" 'yazdırma alanı
'Sheets(1).PrintOut Copies:=1 'yazdırır
ActiveWindow.SelectedSheets.PrintPreview
On Error Resume Next

End Sub

'PDF'e Çevir Başlangıç
'Dim Yol As String
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
'Yol = ThisWorkbook.Path
'say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
'Sheets("TABLO").PageSetup.PrintArea = "$A$1:$AV$75"
'Sheets(Array("TABLO")).Select
'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & say & ".pdf", _
'Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
'OpenAfterPublish:=True
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
'ActiveWindow.SelectedSheets.PrintPreview 'excel sayfasında önizleme yapıyor
'PDF'e Çevir Bitiş