İki tarih aralığında PDF kaydetme

[excellkurdu]

Merhaba Arkadaşlar,
Servis formumda Y4 hücresinde açılır liste halinde tek bir tarih kısmı var. Buradaki tarih değiştikçe Form içerisindeki bilgiler değişiyor. İstedğim tarihe göre de PDF formatında kayıt yapıyorum.
Fakat bazen 10 larca tarihe ait servis formu kaydetmem gerekiyor.
Örnekte verdiğim dosyada AH4 ile AJ4 tarihleri arasındaki olan tarihleri nasıl yazdırabilirim.
Bir başka deyişle ikinci yol şöyle de olabilir. Y4 hücresi, AH4-AJ4 aralığına göre sırayla nasıl değişebilir? Yani Y4 ü ben elle değiştirmeden aralığa göre kendi değişecek.
Saygılarımla

 

[asi_kral]

Error ( Makro bölümü şifreli )

 

[excellkurdu]

Error ( Makro bölümü şifreli )

Gözden kaçtı özür dilerim. Düzelttim.

 

[asi_kral]

Merhaba
Pdf kaydetme makrosunu bununla değiştirip dener misiniz?

Sub PDF_Kaydet_Servis()
Dim STR As Long
Sheets("ServisFORMU").Select
dosya_adı = Cells(1, "a").Value
If dosya_adı = "C:\deneme\" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
'a = MsgBox("hkjhjkhkj", vbYesNo + vbInformation, " Uyarı")
'If a = vbYes Then
For STR = Range("AH4") To Range("AJ4")
Range("Y4") = STR
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'MsgBox "kjhkjhkjhkj sonnnn "
'End If
'If a = vbNo Then
'MsgBox "İşlemi İptal Ettiniz.!"
'End If
Next
End Sub

 

[excellkurdu]

Hocam denedim. Tek bir form kaydediyor. Yani 24.10.2016- 15.11.2016 arasını seçtim. 6 adet pdf kaydetmesi gerekirken, sadece "SERVIS_RAPORU_2016.11.15.pdf" formatı verdi.

 

[askm]

Ekteki şekilde deneyin.

 

[asi_kral]

Hocam denedim. Tek bir form kaydediyor. Yani 24.10.2016- 15.11.2016 arasını seçtim. 6 adet pdf kaydetmesi gerekirken, sadece "SERVIS_RAPORU_2016.11.15.pdf" formatı verdi.

Sizce öyle olması gerekmiyor mu?
Dosya adını siz kendiniz belirlemiştiniz.

Sub PDF_Kaydet_Servis()
Dim STR As Long
Sheets("ServisFORMU").Select
If dosya_adı = "C:\deneme\" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
'a = MsgBox("hkjhjkhkj", vbYesNo + vbInformation, " Uyarı")
'If a = vbYes Then
For STR = Range("AH4") To Range("AJ4")
Range("Y4") = STR
dosya_adı = Cells(1, "a").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'MsgBox "kjhkjhkjhkj sonnnn "
'End If
'If a = vbNo Then
'MsgBox "İşlemi İptal Ettiniz.!"
'End If
Next
End Sub

Bu kod ile istediğinizi yapabilirsiniz

 

[excellkurdu]

Asi Kral hocam emeğinize teşekkür ederim. Sizin koda Askm hocamın If Range("e4") <> "" Then eklentisiyle istediğim oldu.
Tek sorun tarihleri gün gün taraması zaman kaybına neden oluyor. Sadece olan tarihleri alsa süper olurdu. Ama buna da şükür. Hepinize teşekkür ederim.

 

[asi_kral]

Asi Kral hocam emeğinize teşekkür ederim. Sizin koda Askm hocamın If Range("e4") <> "" Then eklentisiyle istediğim oldu.
Tek sorun tarihleri gün gün taraması zaman kaybına neden oluyor. Sadece olan tarihleri alsa süper olurdu. Ama buna da şükür. Hepinize teşekkür ederim.

O zaman kodu bununla değiştirip deneyin.

Sub PDF_Kaydet_Servis()
Dim STR As Long
Sheets("ServisFORMU").Select
If dosya_adı = "C:\deneme\" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
'a = MsgBox("hkjhjkhkj", vbYesNo + vbInformation, " Uyarı")
'If a = vbYes Then
For STR = Range("AH4") To Range("AJ4")
If WorksheetFunction.CountIf(Sheets("Dataservis").Range("C:C"), STR) > 0 Then
Range("Y4") = STR
dosya_adı = Cells(1, "a").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı & "-" & Format(Range("Y4"), "dd.mm.yyyy"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'MsgBox "kjhkjhkjhkj sonnnn "
'End If
'If a = vbNo Then
'MsgBox "İşlemi İptal Ettiniz.!"
'End If
End If: Next
End Sub

 

[excellkurdu]

O zaman kodu bununla değiştirip deneyin.

Sub PDF_Kaydet_Servis()
Dim STR As Long
Sheets("ServisFORMU").Select
If dosya_adı = "C:\deneme\" Then
MsgBox "Dosya adı yok"
Exit Sub
End If
'a = MsgBox("hkjhjkhkj", vbYesNo + vbInformation, " Uyarı")
'If a = vbYes Then
For STR = Range("AH4") To Range("AJ4")
If WorksheetFunction.CountIf(Sheets("Dataservis").Range("C:C"), STR) > 0 Then
Range("Y4") = STR
dosya_adı = Cells(1, "a").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & dosya_adı & "-" & Format(Range("Y4"), "dd.mm.yyyy"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'MsgBox "kjhkjhkjhkj sonnnn "
'End If
'If a = vbNo Then
'MsgBox "İşlemi İptal Ettiniz.!"
'End If
End If: Next
End Sub

Hocam ellerine ve emeğine sağlık. 1 bucuk aylık aralığı denedim. Önceki kod 28sn de, son gönderdiğin 11sn de tamamladı. Çok teşekkür ederim.