Farklı Kaydet Seçeneği

[speech_free]

Merhaba,

Stok takibi ile ilgili bir dosya hazırladım. Bu dosya toplamda yanlış hatırlamıyorsam 52 sayfadan oluşuyor. İlk sayfa Veri Girişi, ikinci sayfa da Stok Hareketleri. Diğerleri de stokların bulunduğu sayfalar. Biz bunu farklı kaydederek PDF olarak saklıyoruz fakat ilk iki sayfayı yani Veri Girişi ve Stok Hareketleri isimli sayfaları PDF içinde görmek istemiyoruz. Bunun için şu an Ctrl tuşuna basılı tutarak PDF içinde olmasını istediğimiz sayfalara tek tek tıklıyoruz. Bu da çok zaman alıcı ve zahmetli. Bu işlemi daha pratik yapmanın bir yolu var mıdır?

Teşekkürler.

 

[Korhan Ayhan]

CTRL yerine SHIFT tuşunu kullanarak sayfa aralığını hızlıca seçebilirsiniz.

İlk sayfayı seçin. Ardından SHIFT tuşuna basılı tutarak son sayfayı seçin. Aradaki tüm sayfalar seçilmiş olacaktır.

Bunun dışında makro ile seri bir şekilde işlemi yapabilirsiniz.

 

[halit3]

Bir userform oluşturun üstünede aşağıdaki nesnelerini ekleyin
ListBox1
CheckBox1
CommandButton1

Private Sub CheckBox1_Click()
Dim i As Integer
For i = 1 To ListBox1.ListCount
ListBox1.Selected(i - 1) = CheckBox1.Value
Next
End Sub

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yer = ActiveSheet.Name
Dim myArray() As Variant
Dim i As Integer

son = 0
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
son = 1
Exit For
End If
Next
If son = 0 Then
MsgBox "Sayfa seçimi yapmadınız"
Exit Sub
End If

dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name

For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
ReDim Preserve myArray(n)
myArray(n) = i
n = n + 1
End If
Next

Sheets(myArray).Select

Dim yol As String
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
[COLOR="Red"]say[/COLOR] = CreateObject("Scripting.FileSystemObject").getfolder(yol).Files.Count + 1

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & "\" & [COLOR="red"]say[/COLOR] & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Application.ScreenUpdating = True
Application.DisplayAlerts = True

 Sheets(yer).Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

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

 

[speech_free]

Korhan Bey, vermiş olduğunuz bilgi için teşekkür ederim.

Halit Bey size de makro için teşekkür ediyorum. Dediğiniz gibi userform oluşturup nesneleri ekledim ama bu kodu nereye ekleyeceğim? Ve bu userformu sayfaya nasıl ekliyoruz? İlk defa yapıyorum da.

*Sanırım anladım kodları nereye ekleyeceğimi. Nesnenin üstüne gelip sağ tıklayıp kodu görüntüle dedikten sonra ilgili yere yazacağım ama hala işleyişi kavrayamadım tam olarak.

 

[halit3]

bir modül oluşturun ve kodu oraya yapıştırın

Sub deneme()
UserForm1.Show 0
End Sub

bu kodu sayfaya ekleyeceğiniz bir form komut düğmesine sağ tıklayın ve makro ata seçeneğini seçin ve tamamı tıklayın

veya sayfanın kod bölümüne bu kodu yapıştırın

Private Sub CommandButton1_Click()
UserForm1.Show 0
End Sub

ve sayfaya bir Activex denedimlerinden komut düğmesi ekleyin kodu çlıştırın


ayrıca aşağıdaki linkide irdeleyiniz.

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

 

[speech_free]

PDF olarak kaydetmeyi başardım. Çok teşekkür ederim. Ufak bir sorum daha olacaktı. PDF dosyalarına isim verirken 34, 35, 36, 37 gibi isimler verdi. Bunu kodun içinde göremedim. Excel dosyasının ismini alması mümkün müdür?

 

[halit3]

3 nolu mesajda kırmızı yerlerden alıyor

 

[speech_free]

Tamamdır. Sanırım verdiğiniz linkteki örneklerle bu işi kotarabilirim gibime geliyor. Yapamazsam kapınızı çalarım tekrar. Emeğinize sağlık tekrardan.

 

[halit3]

birde bu kodları dene

Private Sub CheckBox1_Click()
Dim i As Integer
For i = 1 To ListBox1.ListCount
ListBox1.Selected(i - 1) = CheckBox1.Value
Next
End Sub


Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

say1 = 0

Dim i As Integer
son = 0
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
son = 1
Exit For
End If
Next
If son = 0 Then
MsgBox "Sayfa seçimi yapmadınız"
Exit Sub
End If


For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then

say1 = say1 + 1
If say1 = 1 Then
ThisWorkbook.Sheets(ListBox1.List(i - 1)).Copy

ActiveSheet.DrawingObjects.Delete
Else
ThisWorkbook.Sheets(ListBox1.List(i - 1)).Copy After:=ActiveWorkbook.Sheets(1)
say = ActiveWorkbook.Sheets.Count
Sheets(ActiveSheet.Name).Move After:=Sheets(say)
ActiveSheet.DrawingObjects.Delete

End If

End If
Next

If say1 > 0 Then
ActiveWorkbook.Worksheets.Select

say = CreateObject("Scripting.FileSystemObject").getfolder(ThisWorkbook.Path).Files.Count + 1
dosya = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)

ActiveWorkbook.Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & dosya & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.Close False
End If
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub

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

 

[speech_free]

say kısmını silerek istediğim dosya ismini elde ettim ama bu kod ile 1. ve 2. sayfayı seçmiş olmama rağmen tek sayfayı kaydediyor ve ikinci sayfadan başlıyor kayıt işlemine.

 

[halit3]

Dosyadaki seçili sayfaları ayrı ayrı mı pdf dosyası yapmak istiyorsunuz yoksa seçili sayfaları tek pdf dosyası mı yapmak istiyorsunuz.?

şu an kendinizin derlediği kodun son halini buraya ekleyin bir bakalım.

 

[speech_free]

Seçili sayfaları tek PDF dosyası yapmak istiyorum. Derleme demeyelim ona Halit Bey. Ufak bir yeri sildim sadece. Keşke o kadar derleyecek bilgim olsaydı. Öğrenmeye de çalışıyorum bu şekilde ama zor oluyor gerçekten. Son gönderdiğiniz kodun içinden sadece say ifadesini sildim dosya adının nasıl yazılacağı ile ilgili satırdan.

Private Sub CheckBox1_Click()
Dim i As Integer
For i = 1 To ListBox1.ListCount
ListBox1.Selected(i - 1) = CheckBox1.Value
Next
End Sub


Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

say1 = 0

Dim i As Integer
son = 0
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
son = 1
Exit For
End If
Next
If son = 0 Then
MsgBox "Sayfa seçimi yapmadınız"
Exit Sub
End If


For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then

say1 = say1 + 1
If say1 = 1 Then
ThisWorkbook.Sheets(ListBox1.List(i - 1)).Copy

ActiveSheet.DrawingObjects.Delete
Else
ThisWorkbook.Sheets(ListBox1.List(i - 1)).Copy After:=ActiveWorkbook.Sheets(1)
say = ActiveWorkbook.Sheets.Count
Sheets(ActiveSheet.Name).Move After:=Sheets(say)
ActiveSheet.DrawingObjects.Delete

End If

End If
Next

If say1 > 0 Then
ActiveWorkbook.Worksheets.Select

say = CreateObject("Scripting.FileSystemObject").getfolder(ThisWorkbook.Path).Files.Count + 1
dosya = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)

ActiveWorkbook.Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & dosya & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.Close False
End If
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub

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

 

[halit3]

şu an kendi derlediğiniz kodun son halini eklermisiniz.