Soru pdf yapma macro yavaşlığı

[incsoft]

Aşağıdaki macrom çok aşırı şekilde yavaş neden olabilir arkadaşlar?


Sub PDFYAP()
Dim yol As String, yil As Integer, ay As String, gun As String
yol = "\\DS1\ortak\DT\KİŞİŞEL KLASÖRLER\Uİ\GÜNLÜK GÖNDERİLECEK MAİLLER\"
yil = Year(Date)
ay = Month(Date)
gun = ActiveSheet.Name


If Len(ay) < 2 Then ay = 0 & ay

ActiveSheet.Range("A1:Q164").ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityMinimum, OpenAfterPublish:=True, fileName:=yol & "TR - " & yil & "-" & ay & "-" & gun & ".pdf"
End Sub

 

[Korhan Ayhan]

Merhaba,

Bahsi geçen ortak klasöre erişiminiz yavaş olabilir. Belki oluşan dosyayı yerel masaüstüne kayıt ettirip kopyala-yapıştır ile ilgili klasöre aktarmak daha hızlı sonuç verebilir.

 

[incsoft]

Merhaba,

Bahsi geçen ortak klasöre erişiminiz yavaş olabilir. Belki oluşan dosyayı yerel masaüstüne kayıt ettirip kopyala-yapıştır ile ilgili klasöre aktarmak daha hızlı sonuç verebilir.

O macro ile nasıl olur Korhan bey? Teşekkürler

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub PDFYAP()
    Dim masaustu As String
    Dim hedefYol As String
    Dim yil As String, ay As String, gun As String
    Dim dosyaAdi As String
    Dim kaynakDosya As String, hedefDosya As String

    '--- Yollar
    masaustu = Environ("USERPROFILE") & "\Desktop\"
    hedefYol = "\\DS1\ortak\DT\KİŞİŞEL KLASÖRLER\Uİ\GÜNLÜK GÖNDERİLECEK MAİLLER\"

    '--- Tarih bilgileri
    yil = Year(Date)
    ay = Format(Month(Date), "00")
    gun = ActiveSheet.Name

    '--- Dosya adı
    dosyaAdi = "TR - " & yil & "-" & ay & "-" & gun & ".pdf"

    kaynakDosya = masaustu & dosyaAdi
    hedefDosya = hedefYol & dosyaAdi

    '--- PDF'yi masaüstüne oluştur
    ActiveSheet.Range("A1:Q164").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Quality:=xlQualityMinimum, _
        OpenAfterPublish:=False, _
        Filename:=kaynakDosya

    '--- Hedefte varsa sil (overwrite için)
    If Dir(hedefDosya) <> "" Then
        Kill hedefDosya
    End If
   
    '--- Masaüstünden hedef klasöre taşı
    If Dir(kaynakDosya) <> "" Then
        Name kaynakDosya As hedefDosya
    End If

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[incsoft]

Deneyiniz.

Option Explicit

Sub PDFYAP()
    Dim masaustu As String
    Dim hedefYol As String
    Dim yil As String, ay As String, gun As String
    Dim dosyaAdi As String
    Dim kaynakDosya As String, hedefDosya As String

    '--- Yollar
    masaustu = Environ("USERPROFILE") & "\Desktop\"
    hedefYol = "\\DS1\ortak\DT\KİŞİŞEL KLASÖRLER\Uİ\GÜNLÜK GÖNDERİLECEK MAİLLER\"

    '--- Tarih bilgileri
    yil = Year(Date)
    ay = Format(Month(Date), "00")
    gun = ActiveSheet.Name

    '--- Dosya adı
    dosyaAdi = "TR - " & yil & "-" & ay & "-" & gun & ".pdf"

    kaynakDosya = masaustu & dosyaAdi
    hedefDosya = hedefYol & dosyaAdi

    '--- PDF'yi masaüstüne oluştur
    ActiveSheet.Range("A1:Q164").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Quality:=xlQualityMinimum, _
        OpenAfterPublish:=False, _
        Filename:=kaynakDosya

    '--- Hedefte varsa sil (overwrite için)
    If Dir(hedefDosya) <> "" Then
        Kill hedefDosya
    End If
  
    '--- Masaüstünden hedef klasöre taşı
    If Dir(kaynakDosya) <> "" Then
        Name kaynakDosya As hedefDosya
    End If

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Teşekkür ederim çok güzel olmuş

 

[Korhan Ayhan]

Hızlandı mı peki!

 

[incsoft]

Hızlandı mı peki!

Evet Korhan bey diğerine göre hızlı.