Pdf kaydet buton kodunda değişiklik

[zulfuernek]

Dim ds, cs As Object
Dim gds
Dim dosya As String
Dim yıl As Integer
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\"

If IsDate(ActiveSheet.Name) = True Then
yıl = Year(ActiveSheet.Name)
If cs.FolderExists(gds & "\KASA YEDEKLERİ\" & yıl) = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & yıl

Else
MsgBox "AKTİF SAYFA ADINDA SORUN VAR"
Exit Sub
End If

dosya = gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf"
If cs.FileExists(dosya) = True Then Kill dosya

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=True

MsgBox "Bilgiler Kaydedildi", vbInformation, "ANAKASA"


Yukarıdaki kodla butona tıklayınca masaüstüne KASA YEDEKLERİ adında klasör açıyor. ve o klasör içerisinde de hangi yıldaysak o yıla ait bir dosya açıyor ve aktif sekme adında bütün sayfaları pdf olarak kaydediyor.

SORU: aktif sayfa adında değilde "AO1" hücresinde hangi değer varsa o isimde ve sadece "A1;AO71" aralığını pdf olarak kaydetmesini istiyorum

 

[Ömer BARAN]

Merhaba.

İlgili kısmı aşağıdaki şekilde değiştirerek deneyin.
.

........
dosya = gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.[B][COLOR="blue"][AO1].Value[/COLOR][/B] & ".pdf"
.......
[B][COLOR="Blue"][A1:AO71][/COLOR][/B].ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.[B][COLOR="blue"][AO1].Value[/COLOR][/B] & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=True

SONRADAN İLAVE NOT: Ben denemiş değilim Sayın PLİNT'in cevabını da göz önünde bulundarmınazda yarar var.

 

[PLİNT]

Merhaba
Ömer Bey in belirttiği şeklin yanı sıra aralığı belirlemek için aşağıdaki kırmızı bölümleri ekleyip/değiştirip deneyin

[SIZE="2"]
dosya = gds & "\KASA YEDEKLERİ\" & yıl & "\" &[COLOR="Blue"] ActiveSheet.[AO1].Value[/COLOR] & ".pdf"
If cs.FileExists(dosya) = True Then Kill dosya
 [COLOR="Red"] ActiveSheet.PageSetup.PrintArea = "$A$1:$AO$71"[/COLOR]
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & [COLOR="Blue"]ActiveSheet.[AO1].Value[/COLOR] & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, [COLOR="Red"]IgnorePrintAreas:=False[/COLOR], _
OpenAfterPublish:=True

MsgBox "Bilgiler Kaydedildi", vbInformation, "ANAKASA"

End Sub[/SIZE]

 

[zulfuernek]

hocalarım her iki kodda aktif sayfa adında hata var uyarısı veriyor. aktif sayfa adınıda belirlil bir sheeti tanımlamama rağmen.

şöyle izah edeyim.

Bir buton olacak butona tıkladığım zaman masaüstünde "KASA YEDEKLERİ" adında klasör açacak

ayrıca bu klasörün içerisinede "AO1" hücresinde bulunan "22.02.2018" tarihi formatında olan tarihe ait yıl isminde bir dosya açacak yani "masaüstü\kasayedekleri\2018\02\" diye doya açacak

dosyanın içerisinede "ao71" hücresindeki veri adını vererek "a1;ao71"i pdf olarak kaydedicek

 

[PLİNT]

dosyanın içerisinede "ao71" hücresindeki veri adını vererek "a1;ao71"i pdf olarak kaydedicek

Aşağıdaki gibi deneyin, Dosya adı ilk mesajınızdaki gibi "AO1" den değilde
"AO71" den alınacaksa aşağıdaki kırmızı bölümü " & Activesheet.[AO71].value & " şeklinde değiştirirsiniz

[SIZE="2"]Private Sub CommandButton1_Click()

Dim ds, cs As Object
Dim gds
Dim x
Dim dosya As String
Dim yıl As Integer
Set cs = CreateObject("Scripting.FileSystemObject")
Set ds = CreateObject("WScript.Shell")
gds = ds.SpecialFolders("Desktop")

If cs.FolderExists(gds & "\KASA YEDEKLERİ") = False Then cs.CreateFolder gds & "\" & "KASA YEDEKLERİ"
If cs.FolderExists(gds & "\KASA YEDEKLERİ\") = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\"
x = ActiveSheet.[AO1].Value
If IsDate(x) = True Then
yıl = Year(x)
ay = Month(x)
If cs.FolderExists(gds & "\KASA YEDEKLERİ\" & yıl) = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & yıl
If cs.FolderExists(gds & "\KASA YEDEKLERİ\" & yıl & "\" & ay) = False Then cs.CreateFolder gds & "\KASA YEDEKLERİ\" & yıl & "\" & ay
Else
MsgBox "[AO1] hücresindeki veri tarih olamalıdır"
Exit Sub
End If
dosya = gds & "\KASA YEDEKLERİ\" & yıl & "\" & ay & "\" & x & ".pdf"
If cs.FileExists(dosya) = True Then Kill dosya
Range("$A$1:$AO$71").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ay & "\" [COLOR="Red"]& x &[/COLOR] ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=True

MsgBox "Bilgiler Kaydedildi", vbInformation, "ANAKASA"

End Sub[/SIZE]

 

[zulfuernek]

Sayın PLINT hocam eline emeğine sağlık tam istediğim dosyalama sistemi olmuş. ancak bişeyi merak ettim sonlara doğru x ile kırmızı yazdığınız x in cazibesi nedir? herhangi bir değişiklik yapmadım orda. fakat o x in anlamını merakettim açıkçası.

Birde syın hocam bi sorum daha var. yazdır butonu oluşturdum faka 2 tane yazıcı var. 1. si kendi sisteminie bağlı yazıcı diğeri ise genel kullanıma açık yazıcı. ben yazıdr butonuna tıklayınca hangi yazıcıdan yazdırmam gerktiğini seçmek istiyorum. yani yazıcı seçme ekranını amadan direk ortak yazıcıya gönderiyor. fakat ben hangi yazıcıya gitmesi gerekiğini seçmek istiyorum. nasıl bir kod yazabilirim bunun için

 

[Korhan Ayhan]

Aşağıdaki kodu deneyebilirsiniz.

Sub Yazici_Secimi()
    Yazici = Application.Dialogs(xlDialogPrint).Show
    If Yazici = False Then Exit Sub
End Sub