• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Adet kadar sayfa aç, numaralandır ve pdf olarak kaydet makrosu hk.

  • Konbuyu başlatan Konbuyu başlatan chngrcn
  • Başlangıç tarihi Başlangıç tarihi
C

chngrcn

Katılım
5 Mart 2010
Mesajlar
295
Excel Vers. ve Dili
Microsoft Office 2010
Forumun değerli üyeleri;

A1 Hücresine sayfa adedi
A2 Hücresine oluşturulacak dosyanın adını yazdık diyelim.

buton yardımı ile,
- A1 hücresindeki kadar sayfa açacak
- Her sayfanın üstbilgisi'nin sağ köşeye sayfa numarası yazacak
- Çalışmayı A2 hücresine girilen isim ile PDF olarak kaydedip döngüyü sonlandıracak bir kod yazılabilir mi ?

yardımlarınız için şimdiden teşekkür ederim.. Saygılarımla..
 
Örnek dosya atarsanız yapılabilir tabiki.
 
Örnek dosya mı ?

boş bir excel sayfası açıp a1 hücresine 100 yazın, a2 hücresine herhangibir isim yazın.. alın size örnek dosya.. bu sorunun nesine örnek dosya ekleyeyim ?
 
chngrcn' Alıntı:
Örnek dosya mı ?

boş bir excel sayfası açıp a1 hücresine 100 yazın, a2 hücresine herhangibir isim yazın.. alın size örnek dosya.. bu sorunun nesine örnek dosya ekleyeyim ?
Genişletmek için tıkla ...

Slmlar nezaket gereği konu farklı yonlere dallandıgı için (sorunun dısında daha farklı istekler istendigi için ) isteginiz uzere ornek dosya istenmiş ifadenizi eğitim seviyesi ve diger etik kuralları acısından hoş bulmadım. Size baska arkadaslar yardımcı olurlar mı Bilemiyorum ?
 
Nezaketsizlik veyahut birilerine karşı şahsi bir sorunum olduğunu sanmıyorum. Soru gayet net bir şekilde ifade edilmiş. Kimseye karşı bir saygısızlığımızda söz konusu değildir. Örnek dosya eklemememin sebebi de server'a gereksiz dosyalar ekleyip, lüzumsuz yere server'a yüklenmek istemedim.. 2010 yılından beri bu forumdayım ve kurallarının ve işleyişinin nasıl olduğunu çok iyi biliyorum..

Kaldı ki bu kadar açık ve net bir soru için örnek dosya eklemenin lüzumsuz olacağı kanaatindeyim.. Yardımcı olmak isteyen arkadaşımın üslubümü sert algılamamasını rica ederim.

Sert algılandı ise özür dileyecek erdemde bir insanım.. bunun eğitimimlede alakası yoktur. Herşeyden önce insanım..

Yardımcı olacak arkadaşlarıma teşekkür eder, şahsıma karşı göstermiş olduğunuz itimat ve teveccühün devamlılığını dilerim. Saygılar..
 
Amacım örnek dosya isteyerek size zahmet vermek değil. İstediğiniz formata uygun olması açısından istedim. Bazen çok basit bir kod dahi sayfa tasarımından dolayı yapamadım şikayetleri geliyor. O yüzden. Aşağıdaki kodlar işinize yarar diye düşünüyorum.
Kod: 
Sub Sayfa_Ekle()
Dim ad As String, i As Integer, bulundu As Boolean, a As Long
    For a = 1 To Sheets("Sayfa1").Cells(1, "A").Value 'Range("a65536").End(3).Row
    bulundu = False
    ad = Sheets("Sayfa1").Cells(2, "A").Value & a
10  For i = 1 To Worksheets.Count
    If CStr(Sheets(i).Name) = CStr(ad) Then
    bulundu = True
    End If
    Next i
    If bulundu = False Then
    Sheets.Add After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = CStr(ad)
    ''''''''''''''''''''''''''''''''''''''''''''''''
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = a
    End With

''''''''''''''''''''''''''''''''''''''''''''''''
yol = ThisWorkbook.Path
ActiveSheet.Range("A1:J61").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yol & "/" & ad & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True
''''''''''''''''''''''''''''''''''''''''''''''''
    GoTo 10
    End If
    Next a
    
ad = vbNullString
i = Empty: a = Empty
End Sub
 
Sevgili askm,
öncelikle anlayışınız ve yardımlarınız için teşekkür ederim..

Yazdığınız kod a1 hücresine girilen adet kadar sheet açıyor ve sheet'lere numara veriyor, ve çalışma kitabının bulunduğu klasöre 1'den başlayarak girilen adede göre pdf dosyalarını ayrı ayrı kaydediyor. ve bu pdf dosyalarının içeriğine baktığımda 4 sayfalık bir pdf oluşturup her sayfaya aynı numarayı veriyor..

benim istediğimin dışında bi çalışma olmuş..

İstediğim tam olarak şu;

örneğin; A1 hücresine 100 yazdım. A2 hücresine "kitap1" yazdım diyelim..

100 sayfalık bir word belgesi düşünün ve üst bilgi kısmında 1'den başlayarak ...... 100'e kadar sayfaları numaralamış ve bu dosyayı PDF olarak kaydettiğimizde 100 sayfalık tek bir PDF dosyası oluşturmak istiyorum..

yani a1 'e girmiş olduğum adet kadar sayfa oluşturup sayfaları numaralayıp PDF formatında kaydetmesini istiyorum..

ilginiz için tekrar teşekkür ederim.
 
Şu anda çıkıyorum sabah bakarım inşallah.
 
Kod: 
Sub Sayfa_Ekle()
Dim j As Integer
    Dim s()
Dim ad As String, i As Integer, bulundu As Boolean, a As Long
    For a = 1 To Sheets("Sayfa1").Cells(1, "A").Value 'Range("a65536").End(3).Row
    bulundu = False
    ad = Sheets("Sayfa1").Cells(2, "A").Value & a
10  For i = 1 To Worksheets.Count
    If CStr(Sheets(i).Name) = CStr(ad) Then
    bulundu = True
    End If
    Next i
    If bulundu = False Then
    Sheets.Add After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = CStr(ad)
    ''''''''''''''''''''''''''''''''''''''''''''''''
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = a
    End With


    GoTo 10
    End If
    Next a
    ''''''''''''''''''''''''''''''''''''''''''''''''
For i = 2 To Sheets.Count

            ReDim Preserve s(j)
            s(j) = Sheets(i).Name
            j = j + 1

Next i
 
Sheets(s).Select
''''''''''''''''''''''''''''''''''''''''''''''''

yol = ThisWorkbook.Path
ActiveSheet.Range("A1:I40").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yol & "/" & ad & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True
''''''''''''''''''''''''''''''''''''''''''''''''
ad = vbNullString
i = Empty: a = Empty
End Sub
 
Sevgili askm,

1000 sayfalık pdf oluşturmak istesem, 1000 adet sheet mi açacak ? yine tam olarak istediğim olmamış..

excelde aynı sheet içinde 100 adet sayfa açabilir misin ? ( baskı önizlemede 100 sayfa görünecek şekilde )
 
Onu yaparım da üst bilgi kısmı biraz zor. O konuda bilgim yok. Araştırmam gerek.
 
silindi...................
 
Halit hocam, öncelikle saygılar sunarım..

Şimdi ben biraz yaptığım araştırmalar neticesinde örnek bir dosya ekledim. Dosya içerisinde 160 bin küsür sayfa açtım, ve bu sayfalara üst bilgi olarak sayfa numarası ekledim..

Ekteki çalışmamda,

T4 Hücresine başlangıç sayfa no
T5 Hücresine bitiş sayfa numarası ekledim. Belirtilen aralığı yazdırmak için de bir buton koydum ve butona atadığım makro şu;

Kod: 
Sub NUMARALA()
With Worksheets("NUMARA")
If .Range("T4").Value > 0 Then
    basla = Worksheets("NUMARA").Range("T4").Value
    bitis = Worksheets("NUMARA").Range("T5").Value

If MsgBox(" " & basla & " ile " & bitis & " Arası Sayfalar Numaralandırılıcak. Yazıcıya Gönderilsin mi ?", vbYesNo, "Coded by Cihangir") = vbNo Then Exit Sub
    Application.ScreenUpdating = False 'MAKRO ÇALIŞIRKEN YAPILAN İŞLEM EKRANDA GÖRÜNMEZ
    Sheets("NUMARA").Select
    ActiveWindow.SelectedSheets.PrintOut From:="  " & basla & " ", To:="  " & bitis & " ", Copies:=1
    Sheets("NUMARA").Select
    Range("T4").Select
 Else
    MsgBox "Lütfen Numaralandırma İşlemi İçin Başlangıç Sayfa Numarasını Yazınız", 16, "Coded by Cihangir"
  End If
End With
End Sub

bu makro sayesinde belirtilen aralığı yazıcıdan sayfa numaralı bir şekilde çıktı alabiliyorum.

istediğim ise, bir buton daha koydum.. Belirtilen aralığı PDF olarak kaydetmesini istiyorum bu sağlanabilir mi ? saygılar sunarım..
 

Ekli dosyalar

silindi........................
 
Kod: 
Sub farklı_kaydetme_pdf()
say = ActiveSheet.HPageBreaks.Count + 1
bitis = Worksheets("NUMARA").Range("T5").Value * 52
ActiveSheet.PageSetup.PrintArea = "$A$8:$I$" & bitis ' & Range("b65536").End(3).Row

dosya_adı = Cells(3, "T").Value
If dosya_adı = "" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
a = MsgBox(" Kayıt etmek istiyormusunuz.?", vbYesNo + vbInformation, " Uyarı")
If a = vbYes Then
For a = 1 To say
  [k6] = a & " / " & say
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
MsgBox "işlem tamam!"
End If
If a = vbNo Then
MsgBox "işlemi iptal ettiniz.!"
End If
End Sub
 
chngrcn' Alıntı:
Halit hocam, öncelikle saygılar sunarım..

T5 Hücresine bitiş sayfa numarası ekledim. Belirtilen aralığı yazdırmak için de bir buton koydum ve butona atadığım makro ..
Genişletmek için tıkla ...


Alternatif;

Bullzip pdf yazıcı programını yükleyin.
http://www.bullzip.com

Varsayılan yazıcıyı bullzip yapıp aynı kodları kullanabilirsiniz.

Aynı zamanda herhangi bir programdan yazıcıya gönderebildiğiniz herşeyi bu proggram ile pdf e çevirebilirsiniz.
 
Son düzenleme:
Benim eklediğim kodlar sizin sayfaya uyarladım. T3 e PDF dosya adını yazarsınız. Yalnız satır yükseklikleri standart olacak şekilde ayarlı. Normalde bir sayfaya 52 satır sığmakta o yuzden 52 ile çarptım. Satırların yükseklikleri ile oynarsanız sayfa sayısı değişir. 30 yazarsınız 32 veya 28 sayfa yapabilir.
 
Kod: 
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

bu satırda hata veriyor halit hocam
 
yol = ThisWorkbook.Path & "\" & Sheets(SAYFA).Cells(1, "B") burdaki değer boş ise hata verir. Yolu bulamıyor demek.
 
silindi.......................
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst