Pdf kaydetme ile ilgili yardım.

[tekkral.cihan]

Çalışma sayfamı bilgisayar masaüstüne bir klasör açıp bu açılan klasör ismini GİRİŞ sayfasından f12 hücresinden almasını 1-36 numaralı aktif olan sayfaları birleştirerek tek bir pdf dosyası haline getirerek bu klasörün içine atmasını istiyorum yardımcı olursanız sevinirim

 

[Korhan Ayhan]

Kullandığınız excel versiyonunuz nedir?

Profilinizde bu bilgiyi güncellemenizi rica ederim.

 

[tekkral.cihan]

excel 2013 kullanıyorum

 

[hoguz2]

Merhaba ,

Şu dosyayi bir dener misiniz . baska bir calismadan derledim.

http://www.rondebruin.nl/win/s5/pdf.htm


uyarlanmıs örnek dosya
https://wetransfer.com/downloads/18...e771911006bd159b1210118420170822133004/8a2cc3

 

[halit3]

Aaşağıdaki linkdeki 4 nolu mesajdaki kodu irdeleyiniz

http://www.excel.web.tr/f48/secilen-sayfalary-pdf-olarak-yazdyrma-t163022.html

 

[halit3]

Bir başka uygulama için Aşağıdaki linki de irdeleyiniz.

http://www.excel.web.tr/f48/stenen-sayfalary-tek-parca-olarak-pdf-yapmak-t157469.html#post857217

 

[tekkral.cihan]

Halit hocam vediğiniz kod tam istediğim ama sayfa numarası 1-s den 20-s kadar sayfaları alsın sadece o sayfalar listboxta görünmesi lazım

 

[halit3]

Dosyanızdaki sayfa isimleri nasıl gittiğini bilmiyorum ama sorunuzun cevabı burada

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1
For i = 1 To ActiveWorkbook.Sheets.Count
ListBox1.AddItem Sheets(i).Name

Next i
End Sub

kod dosyadaki sayfaları listeliyor sizin istediğiniz listeleme için küçük bir örnek dosya ekleyin bir bakalım.

 

[tekkral.cihan]

http://dosya.co/70zcv3b9ojvg/Yeni_Microsoft_Excel.rar.html

 

[halit3]

Bu kod işini görürmü

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1
For i = 1 To ActiveWorkbook.Sheets.Count
[COLOR="Red"]If Right(Sheets(i).Name, 2) = "-s" Then[/COLOR]
ListBox1.AddItem Sheets(i).Name
[COLOR="red"]End If[/COLOR]
Next i
End Sub

 

[tekkral.cihan]

halit hocam yardımcı olduğunuz için çok sağolun

 

[tekkral.cihan]

Option Explicit
Dim i          As Integer

Private Sub chkAll_Click()
    For i = 1 To lbxSheets.ListCount
        Me.lbxSheets.Selected(i - 1) = Me.chkAll.Value
    Next i
End Sub

Private Sub cmbCancel_Click()
    Unload Me
End Sub

Private Sub cmbPrint_Click()
    For i = 1 To Me.lbxSheets.ListCount
        If Me.lbxSheets.Selected(i - 1) = True Then
            If Me.chkPreview Then
                Me.Hide
                Sheets(Me.lbxSheets.List(i - 1, 0)).PrintPreview
                Me.lbxSheets.Selected(i - 1) = False
            Else
                Sheets(Me.lbxSheets.List(i - 1, 0)).PrintOut
                Me.lbxSheets.Selected(i - 1) = False
            End If
        End If
    Next i
End Sub



Private Sub UserForm_Initialize()
    Dim oWs    As Worksheet
    For Each oWs In Sheets
        If oWs.Type = 3 Then    'Chart sheet
            Me.lbxSheets.AddItem oWs.Name
            'exclude empty sheets
        ElseIf WorksheetFunction.CountA(oWs.Cells) > 0 Then
            Me.lbxSheets.AddItem oWs.Name
        End If
    Next oWs
End Sub

yukarda verdiğim yazdırma kodunu listboxta -s,-K,-ö,-D,-f sayfa adıyla başlayanları listboxta görünmesi için Halit bey bu koda göre uyarlaya bilirmiyiz.

 

[halit3]

Böyle dene

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1
For i = 1 To ActiveWorkbook.Sheets.Count
If Right(Sheets(i).Name, 2) = "-s" Or Right(Sheets(i).Name, 2) = "-K" Or Right(Sheets(i).Name, 2) = "-ö" Or Right(Sheets(i).Name, 2) = "-D" Or Right(Sheets(i).Name, 2) = "-f" Then

ListBox1.AddItem Sheets(i).Name
End If
Next i
End Sub

Yada listelenmeyecek sayfaları kodlara eklememek gerek

Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Name <> "ANASAYFA" Then
If Sheets(i).Name <> "DERSLER" Then
If Sheets(i).Name <> "SINIFLAR" Then

ListBox1.AddItem Sheets(i).Name
End If
End If
End If
Next i
End Sub

 

[tekkral.cihan]

Sağolun halit hocam yardımcı olduğunuz için