Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 12-08-2017, 00:28   #1
zulfuernek
 
Giriş: 24/06/2017
Şehir: elazığ
Mesaj: 304
Excel Vers. ve Dili:
türkçe
Varsayılan sheet ismindeki yıla göre klasör açmak ve veri kaydetmek

Sub PDF()
Dim ds, cs As Object
Dim gds
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İ\"
ChDir gds & "\KASA YEDEKLERİ\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub


yukarıdaki kodla masaüstünde KASA YEDEKLERİ olarak klasör açıyor ve sheetleri kendi ismiyle pdf formatına çevirerek kaydediyor. eğer aynı isimde pdf varsa uyarı vermeden kaydediyor. bunda problem yok.

sorum şu. KASA YEDEKLERİ KLASÖRÜ nü açtı ve sheetleri kendi ismiyle kaydederken sheetin ismi örneğin 13.06.2017 bunu KASA YEDEKLERİ klasörü içerisine sheetin yılı 2017 ise 2017 adında klasör açması ve bu sheeti onun içine kaydetmesi. eğer sheet örneğin 09.12.2019 ise shetteki 2019 yılını baz alarak 2019 adında KASA YEDEKLER içerisine bir klasör daha oluştursun ve yeni yıla ait sheeti onun içerisine kaydetsin.
zulfuernek Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 00:30   #2
zulfuernek
 
Giriş: 24/06/2017
Şehir: elazığ
Mesaj: 304
Excel Vers. ve Dili:
türkçe
Varsayılan

buradaki amaç şu. ben 2017 yılına ait pdf olarak kaydedilmiş verileri ile daha sonraki yıllara ait oluşacak pdf verilerinin ayrı ayrı klasörde olmasını istiyorum. mümkünmüdür? döngü sonsuz olarak devam etmeli. hangi yılda isek KASA YEDEKLERİ içerisine o yıla ait klasör oluşturması o yıla ait pdfleri onun içerisine kaydetmeli
zulfuernek Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 00:45   #3
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,254
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Aktif sayfa adında bulunan yıl için aşağıdaki değişiklikle olabilir;
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub PDF()
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:=False, _
OpenAfterPublish:=False

End Sub

Bu mesaj en son " 12-08-2017 " tarihinde saat 01:30 itibariyle PLİNT tarafından düzenlenmiştir....
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 00:53   #4
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,254
Excel Vers. ve Dili:
Excel 2010
Varsayılan

İçinde bulunulan yıl için;
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub PDF()
Dim ds, cs As Object
Dim gds
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İ\"

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


ChDir gds & "\KASA YEDEKLERİ\" & yıl & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 01:11   #5
zulfuernek
 
Giriş: 24/06/2017
Şehir: elazığ
Mesaj: 304
Excel Vers. ve Dili:
türkçe
Varsayılan

hocam ilk kod oldu sanırım ancak bir sorun var
hangi yılın sjhhetiyse klasörü açıyor ve o yılın verilerini o klasöre kaydediyor
ancak ilk kaydederken sorun yok ama aynı shheti değişiklik yapıp kaydederken aynı isimdeki pdf olduğu için hata veriyor

hata verdiği kod kısmı son kısımlar. aşağıdaki kod yani

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
gds & "\KASA YEDEKLERİ\" & yıl & "\" & ActiveSheet.Name & ".pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
zulfuernek Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 01:32   #6
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,254
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Bende hata vermedi ama
yukarıda (3.mesaj) daki kodlara varsa aynı isimli dosyayı silen bölüm eklendi.
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 15:44   #7
zulfuernek
 
Giriş: 24/06/2017
Şehir: elazığ
Mesaj: 304
Excel Vers. ve Dili:
türkçe
Varsayılan

plint hocam 2. güncellediğiniz şekilde kod oldu. buradaki en sonda bulunan pdf yi aç komutunu false yapınca olay düzeldi. malum pdf açıkken dosya (olurya) isim değişikliği yapmadığından olayı false ile aınlandırdım. ama tam istediğim gibi hangi yıla aitse klasörünü açıyor ve o yıla ait veriyi içerisine atıyor. emeğine sağlık
zulfuernek Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 13:08


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden