Döngü bitince hücreye değer yazdırma sorunu

[nzmsmz]

Merhaba,

aşağıdaki kod ile 1 artırma yaparak farklı bir sayfayı PDF olarak kaydediyor.

Burada 2 sorunum var. Döngü işlemi "L36" hücresinde yazan rakam ne ise onda son buluyor. işlem tamamlandıktan sonra Artırdığı P2 Hücresine otomatik olarak 1 rakamını yazmasını istiyorum. Ama yazmıyor.

PDF leri çıkarma işlemini yaptıktan sonra TYPE mistmatch diye bir uyarı veriyor. Acaba bu uyarı mı 1 değerini yazma kodunu engelliyor.

ikinci konu kaydedeceği yol için açılacağı bilgisayarda otomatik olarak masaüstüne belirlenmesini istiyorum. Bunu zaten hiç beceremedim

Sub PdfKaydet()

For i = 1 To Sheets("Formuldata").Range("L36")
mycount = Range("p2") + 1
Range("p2") = mycount

With Sheets("Pers_det")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:= _
"D:\" & Sheets("Pers_det").Range("b3") & "-" & Sheets("Pers_det").Range("b2").Value, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Next
Range("P2").Select
ActiveCell.FormulaR1C1 = "1"
End Sub

 

[YUSUF44]

Verdiğiniz kodu denediğimde düzgün bir şekilde çalıştı.

Örnek dosyanızı hatalı haliyle paylaşırsanız iyi olur.

 

[Korhan Ayhan]

Masaüstü için aşağıdaki tanımlamalardan birisini kullanabilirsiniz.

Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeperator & "Dosya_Adını_Bu_Bölüme_Yazınız"

Ya da;

Yol = Environ("UserProfile") & Application.PathSeperator & "Desktop" & Application.PathSeperator & "Dosya_Adını_Bu_Bölüme_Yazınız"

 

[nzmsmz]

Verdiğiniz kodu denediğimde düzgün bir şekilde çalıştı.

Örnek dosyanızı hatalı haliyle paylaşırsanız iyi olur.

Yusuf Bey & Korhan Bey teşekkür ederim,

Örnek dosyayı ekledim, bakabilirmisiniz,

test_kopya.xlsm dosyasını indir - download

test_kopya.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s5.dosya.tc

 

[YUSUF44]

Makronuzda yapmak istediğinizi doğru anladıysam makronuzu gereksiz uzattığınızı söyleyebilirim. Anladığım kadarıyla formuldata sayfasında P2 hücresini 1'den başlayarak birer arttırıp her seferinde persdet sayfasını pdf olarak kaydetmek istiyorsunuz. Bunun için hem for next döngüsü hem de mycount değişkeni kullanmanıza gerek yok. For next döngüsü zaten bunun için var. Aşağıdaki makroyu deneyin:

Sub PdfKaydet()
For i = 1 To Sheets("Formuldata").Range("L34")
    Sheets("Formuldata").[P2] = i
    With Sheets("Pers_det")
        .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Environ("USERPROFILE") & Application.PathSeparator & "Desktop" & Application.PathSeparator & _
        Sheets("Pers_det").[B3] & "-" & Sheets("Pers_det").Range("b2").Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
Next
Sheets("Formuldata").[P2] = 1
Sheets("Formuldata").Activate
End Sub

Type Missmatch hatasının sebebi persdet sayfasındaki ilk bilgilerin hata değeri içermesiydi.

Resim ekleme kısmı beni aşıyor.

 

[nzmsmz]

Makronuzda yapmak istediğinizi doğru anladıysam makronuzu gereksiz uzattığınızı söyleyebilirim. Anladığım kadarıyla formuldata sayfasında P2 hücresini 1'den başlayarak birer arttırıp her seferinde persdet sayfasını pdf olarak kaydetmek istiyorsunuz. Bunun için hem for next döngüsü hem de mycount değişkeni kullanmanıza gerek yok. For next döngüsü zaten bunun için var. Aşağıdaki makroyu deneyin:

Sub PdfKaydet()
For i = 1 To Sheets("Formuldata").Range("L34")
    Sheets("Formuldata").[P2] = i
    With Sheets("Pers_det")
        .ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=Environ("USERPROFILE") & Application.PathSeparator & "Desktop" & Application.PathSeparator & _
        Sheets("Pers_det").[B3] & "-" & Sheets("Pers_det").Range("b2").Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    End With
Next
Sheets("Formuldata").[P2] = 1
Sheets("Formuldata").Activate
End Sub

Type Missmatch hatasının sebebi persdet sayfasındaki ilk bilgilerin hata değeri içermesiydi.

Resim ekleme kısmı beni aşıyor.

Ellerinize sağlık çok teşekkür ederim söylediğiniz gibi fazladan kod olmuş içerisinde onu hiç düşünemedim. Resim için Halen araştırmaya devam ediyorum.