[Çözüldü]  TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KARTI)

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KARTI)

İleti#1)  massgrave » 09 Ağu 2019 12:21

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.

Resim
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#2)  massgrave » 09 Ağu 2019 15:09

Bu kod tüm sayfayı pdf olarak kaydediyor. Düzenleyebilecek arkadaş var mı acaba?

Kod: Tümünü seç
Private Sub CommandButton810_Click()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#3)  Ozan İLGÜN » 09 Ağu 2019 15:55

Userform kodlarının en tepesine koyun.Yazdırma butonunuza call pdfyaz() kodunu ekleyin.
Kod: Tümünü seç
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1


Private Sub pdfyaz()
Application.DisplayAlerts = False
    Dim pdfdosya As String
    Dim gizlisayfa As Worksheet
     
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
     
    DoEvents
    Application.Wait (Now + TimeValue("0:00:02"))
   
     
    Set gizlisayfa = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
    gizlisayfa.Select
    gizlisayfa.PasteSpecial
    pdfdosya = ActiveWorkbook.Path & "\" & Me.Name & ".pdf"
    gizlisayfa.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=pdfdosya, Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    gizlisayfa.Delete
    Application.DisplayAlerts = True
     ShellExecute 0, "Open", pdfdosya, "", "", vbNormalNoFocus
     Me.Hide
End Sub
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2826
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (K

İleti#4)  massgrave » 09 Ağu 2019 16:04

Ozan İLGÜN yazdı:Userform kodlarının en tepesine koyun.Yazdırma butonunuza call pdfyaz() kodunu ekleyin.
Kod: Tümünü seç
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As LongPtr, ByVal dwExtraInfo As LongPtr)
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1


Private Sub pdfyaz()
Application.DisplayAlerts = False
    Dim pdfdosya As String
    Dim gizlisayfa As Worksheet
     
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
     
    DoEvents
    Application.Wait (Now + TimeValue("0:00:02"))
   
     
    Set gizlisayfa = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count))
    gizlisayfa.Select
    gizlisayfa.PasteSpecial
    pdfdosya = ActiveWorkbook.Path & "\" & Me.Name & ".pdf"
    gizlisayfa.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=pdfdosya, Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    gizlisayfa.Delete
    Application.DisplayAlerts = True
     ShellExecute 0, "Open", pdfdosya, "", "", vbNormalNoFocus
     Me.Hide
End Sub


Merhaba.
Bu kodları kullandığımda normal form1'i pdf olarak kaydediyor ve gösteriyor.

Ben aşağıdaki formatta textbox'ların içindeki verileri yazdırmak istiyorum. KİŞİ KARTI ÇIKTISI VERİR GİBİ

Yani:
ADI: ALİ VELİ
DOĞUM TARİHİ: 01.01.1955
MEMLEKETİ : İSTANBUL

Resim
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#5)  Ozan İLGÜN » 09 Ağu 2019 16:17

Ozaman bir sayfaya textbox değerlerini kodla yazın sonra onu pdf olarak çevirelim. Bayrama girdiğim için pcye geçemiyorum.
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2826
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#6)  massgrave » 09 Ağu 2019 16:28

Değerleri alacağı TextBox'lar:

Kod: Tümünü seç
[b]KİŞİ KARTI[/b]
[b]Firma Adres Bilgisi[/b]
AD1: TextBox1.text
AD2: TextBox2.text
AD3: TextBox4.text
AD4: TextBox3.text
AD5: TextBox6.text
AD6: TextBox7.text
AD7: TextBox5.text
AD8: TextBox8.text
AD9: TextBox9.text
AD10: TextBox10.text
AD11: TextBox11.text
AD:12 TextBox12.text
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#7)  Ozan İLGÜN » 09 Ağu 2019 19:53

Dosyanızı ekleyebilir misiniz? Bayramdan sonra bakabilirim.
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2826
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#8)  massgrave » 10 Ağu 2019 07:56

Teşekkür ederim. Dosyayı ekledim.
İyi bayramlar.
Bayramdan sonra bu konu üzerinden hatırlatma metni yazarım.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#9)  massgrave » 11 Ağu 2019 15:19

Merhaba 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ı.

Dosyayı ekte göndermiştim. Bayramdan sonra görüşmek üzre.

Kod: Tümünü seç
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
Kod: Tümünü seç
'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ş
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#10)  Ozan İLGÜN » 15 Ağu 2019 14:36

Formun sağındaki yazdır butonuna basın.
Soldaki yazdır butonunu silecektim. Ancak başka yerde kullanıp kullanmadığınızı hatırlayamadığım için silmedim.
Dosyam.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2826
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (K

İleti#11)  massgrave » 15 Ağu 2019 15:17

Ozan İLGÜN yazdı:Formun sağındaki yazdır butonuna basın.
Soldaki yazdır butonunu silecektim. Ancak başka yerde kullanıp kullanmadığınızı hatırlayamadığım için silmedim.
Dosyam.rar


Teşekkür ediyorum. Yazdır denilip PDF olarak kaydedilince aktif formda kapanıyor.
Ne yapabiliriz.
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara

Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#12)  Ozan İLGÜN » 15 Ağu 2019 15:37

Unload Me kısmını kaldırın butondan kapanmasını engellemiş olursunuz.
ozan.ilgun@boun.edu.tr

Resim
Kullanıcı avatarı
Ozan İLGÜN
Forum Moderatörü
 
Adı Soyadı:Ozan İlgün
Kayıt: 20 Şub 2013 12:43
Konum: İst. Maltepe
Meslek: Arşivist
Yaş: 33
İleti: 2826
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul



Cevap: TextBoxları PDF olarak kaydetme ve yazdırma (KİŞİ KAR

İleti#13)  massgrave » 15 Ağu 2019 15:57

Teşekkürler.
İyi Çalışmalar.
Kullanıcı avatarı
massgrave
Yeni Başlamış
 
Kayıt: 24 Haz 2019 19:50
Meslek: Yok
Yaş: 40
İleti: 63
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: fenerbahcem, Yandex[Bot] ve 2 misafir

Bumerang - Yazarkafe