pdf olarak kaydetme sorunu

TURUNCU28 · 21 Mayıs 2017

merhaba forum üyeleri,
Yaptığım exceli pdf olarak kaydetmek istiyorum. dosyamda yapılan işlemin kime ait olduğu ve hangi firmaya ait olduğu belirlenmiş ve pdf olarak tarihte koyarak kaydetme işini yapabiliyorum. kaydetme işini başardım. var olan excel dosyasınıı masaüstündeki eğitim dosyası içindeki hakan dosyasının içindeki x firmasının dosyasının içine pdf+tarih olarak kaydediyor. ancak yine masaüstündeki eğitim dosyası içindeki hakan dosyasının içindeki x firmasının dosyasının içine pdf+tarih olarak kaydet dediğimde hata veriyor. tarih güne göre değişiyor ama bazen aynı güne ait pdfler oluyor. ancak tarih aynı da olsa farklı da olsa dosya isimleri aynı olduğu için sanırım hata alıyorum. benim beceremediğim şu, tüm dosyalar aynı olsa da (masaüstü\eğitim\hakan\xfirması\) pdf e +1 yazıp kaydetsin istiyorum.

masaüstü\eğitim\hakan\xfirması\pdf
masaüstü\eğitim\hakan\xfirması\pdf1
masaüstü\eğitim\hüseyin\xfirması\pdf
masaüstü\eğitim\hüseyin\xfirması\pdf1 gibi olsun istiyorum. şimdiden teşekkürler. umarım anlatabilmişimdir.

denediğim kod şu: (kayıt yapıyor ama aynı isimde dosyalar olunca hata veriyor)

Sub Düğme382_Tıklat()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer

say = 0
For i = 1 To 1
say = say + 1
If say = 1 Then
yer = Range("a1:j35").Select
End If
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
isim = Range("a38")
klasoradi = Range("c6")
dosyaadi = " eğitim katılım formları" & " " & Format(Date, "dd.mm.yyyy")
klasorara = nesne.FolderExists(masaustuyolu & "\eğitim katılım formları\" & isim)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim

nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi & "\" & dosyaadi & "", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next

ActiveSheet.PageSetup.PrintArea = "a1:j35"
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İslemi Tamamlandı." & vbCrLf & say & " Eğitim Katılım Formu İSG Uzmanının Doyasına Kaydedildi", vbInformation, "KAYIT"

End Sub

Mahmut Bayram · 21 Mayıs 2017

formatı saat dakika saniye olarak değiştirebilirsiniz.

Kod:

Format(Now, "dd.mm.yyyy_hh.mm.ss")

TURUNCU28 · 21 Mayıs 2017

Mahmut Bayram' Alıntı:
formatı saat dakika saniye olarak değiştirebilirsiniz.

Kod:

Format(Now, "dd.mm.yyyy_hh.mm.ss")

dediğiniz gibi denedim ancak bu seferde kırmızıyla işaretli yerdeki hatayı veriyor

Sub Düğme382_Tıklat()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer

say = 0
For i = 1 To 1
say = say + 1
If say = 1 Then
yer = Range("a1:j35").Select
End If
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
isim = Range("a38")
klasoradi = Range("c6")
dosyaadi = " eğitim katılım formları" & " " & Format(Now, "dd.mm.yyyy_hh.mm.ss")
klasorara = nesne.FolderExists(masaustuyolu & "\eğitim katılım formları\" & isim)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim

nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi & "\" & dosyaadi & "", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next

ActiveSheet.PageSetup.PrintArea = "a1:j35"
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İslemi Tamamlandı." & vbCrLf & say & " Eğitim Katılım Formu İSG Uzmanının Doyasına Kaydedildi", vbInformation, "KAYIT"

End Sub

Mahmut Bayram · 21 Mayıs 2017

Dosya zaten var hatası alıyorsunuz.
Hata kodunu aldığınız yerin üzerine ekleyip dener misiniz!

Kod:

On Error Resume Next

PLİNT · 21 Mayıs 2017

Merhaba
Alternatif olarak;
Klasör olduğu halde klasör oluşturmaya çalışıyor.
Klasör oluşturan kısmı aşağıdaki kırmızı bölümlerin arasına alarak deneyin

Kod:

[SIZE="2"]
Sub Düğme382_Tıklat()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer


say = 0
For i = 1 To 1
say = say + 1
If say = 1 Then
yer = Range("a1:j35").Select
End If
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
isim = Range("a38")
klasoradi = Range("c6")
dosyaadi = " eğitim katılım formları" & " " & Format(Now, "dd.mm.yyyy_hh.mm.ss")
klasorara = nesne.FolderExists(masaustuyolu & "\eğitim katılım formları\" & isim)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim
If nesne.FolderExists(masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi) = False Then
nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi
End If

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi & "\" & dosyaadi & "", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next


ActiveSheet.PageSetup.PrintArea = "a1:j35"
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İşlemi Tamamlandı." & vbCrLf & say & " Eğitim Katılım Formu İSG Uzmanının Dosyasına Kaydedildi", vbInformation, "KAYIT"


End Sub
[/SIZE]

TURUNCU28 · 21 Mayıs 2017

ilginiz için çok teşekkürler. sorun çözüldü dediğiniz yöntemlerle. bir sorun daha var aslında. o da aynı programdaki tarih sorunu. bir hücreye makrodan tarih atadım. diğer hücreye de ondan 1 gün önceyi göstermesini istedim. ancak pazartesi günü geldiğinde diğer hücre pazarı gösteriyor. benim istediğim pazar günü değil cumartesi gününü göstermesi. yani 22/05/2017 c8 hücresindeyse, c7 hücresinde 20/05/2017 olmasını istiyorum. yardımcı olursanız sevinirim.

bahsettiğim kod şu:

Private Sub CheckBox12_Click()
If CheckBox12.Value = True Then
Sayfa1.Range("B8").Value = "ÇİFT OTURUM"
CheckBox9.Value = 0
Else
Range("B8").ClearContents
End If
If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
Sheets("Sayfa3").[C9] = Format(Date, "dd.mm.yyyy ")
End If
If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
Sheets("Sayfa3").[C8] = Format(Date - 1, "dd.mm.yyyy ")
End If

End Sub

Asri · 21 Mayıs 2017

TURUNCU28' Alıntı:
Private Sub CheckBox12_Click()
If CheckBox12.Value = True Then
Sayfa1.Range("B8").Value = "ÇİFT OTURUM"
CheckBox9.Value = 0
Else
Range("B8").ClearContents
End If
If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
Sheets("Sayfa3").[C9] = Format(Date, "dd.mm.yyyy ")
End If
If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
Sheets("Sayfa3").[C8] = Format(Date - 1, "dd.mm.yyyy ")
End If

End Sub

en sondaki IF i aşağıdaki şekilde değiştirip deneyiniz.

Kod:

If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
   If Weekday(Date - 1, vbMonday) = 7 Then
      Sheets("Sayfa3").[C8] = Format(Date - 2, "dd.mm.yyyy ")
   Else
      Sheets("Sayfa3").[C8] = Format(Date - 1, "dd.mm.yyyy ")
   End If
End If

TURUNCU28 · 21 Mayıs 2017

sorun çözüldü diye yazdım ama başka bir denememde de aşağıdaki kırmızı alanda hata aldım.

masaüstü\eğitim\hakan\xfirması\pdf
masaüstü\eğitim\hakan\xfirması\pdf1
Kişi ve firma aynı iken sorun yok. pdf saniye farkından yeni olarak görüyor yüklüyor. ancak x firması yerine y firması olunca hakan dosyasının içine değil kayıtlı x firmasının içine attı ve hata verdi.

masaüstü\eğitim\hakan\yfirması\pdf

Sub Düğme382_Tıklat()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer

say = 0
For i = 1 To 1
say = say + 1
If say = 1 Then
yer = Range("a1:j35").Select
End If
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
isim = Range("a38")
klasoradi = Range("c6")
dosyaadi = " eğitim katılım formları" & " " & Format(Now, "dd.mm.yyyy_hh.mm.ss")
klasorara = nesne.FolderExists(masaustuyolu & "\eğitim katılım formları\" & isim)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim
If masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi = False Then
nesne.CreateFolder masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi

End If

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
masaustuyolu & "\eğitim katılım formları\" & isim & "\" & klasoradi & "\" & dosyaadi & "", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next

ActiveSheet.PageSetup.PrintArea = "a1:j35"
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İşlemi Tamamlandı." & vbCrLf & say & " Eğitim Katılım Formu İSG Uzmanının Dosyasına Kaydedildi", vbInformation, "KAYIT"

End Sub

TURUNCU28 · 21 Mayıs 2017

Teşekkürler asri sorun çözüldü emeğine sağlık. belki abartı olacak ama resmi tatilleri eklemek çok zor olur mu ya da mümkün müdür?

Asri · 21 Mayıs 2017

TURUNCU28' Alıntı:
Teşekkürler asri sorun çözüldü emeğine sağlık. belki abartı olacak ama resmi tatilleri eklemek çok zor olur mu ya da mümkün müdür?

Resmi tatil günlerini aşağıdaki şekilde deneyiniz.
Buradaki satırı kendinize göre de düzenleyebilir siniz.
Program eklenen tarihleri resmi tatil günü kabul edecektir.

resmitatiltarih = Array("01.01.2017", "23.04.2017", "01.05.2017", "19.05.2017", "24.06.2017", "25.06.2017", "26.06.2017", "27.06.2017", "30.08.2017", "31.08.2017", "01.09.2017", "02.09.2017", "03.09.2017", "04.09.2017", "28.10.2017", "29.10.2017")

kodlardaki FOR J=1 döngüsü,
diyelimki tarih Kurban bayramının 4. günene denk geldi. bir önceki güne bakar. o tarih 3. gününe geldi bir öncekine bakar bu şekilde resmi tatil olmayan yada pazar olmayan bir gün bulana kadar geri gider. Ancak en fazla bir haftalık geri bakar.

Kod:

Private Sub CheckBox12_Click()
  If CheckBox12.Value = True Then
     Sayfa1.Range("B8").Value = "ÇİFT OTURUM"
     CheckBox9.Value = 0
  Else
     Range("B8").ClearContents
  End If
  
  If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
     Sheets("Sayfa3").[C9] = Format(Date, "dd.mm.yyyy ")
  End If
  
  If Sayfa1.Range("B8").Value = "ÇİFT OTURUM" Then
     tarihne = Date
     For j = 1 To 7
        tarihne = tarihne - 1
        If Weekday(tarihne, vbMonday) = 7 Or resmitatil(tarihne) Then
               
        Else
           Sheets("Sayfa3").[C8] = Format(tarihne, "dd.mm.yyyy ")
           Exit For
        End If
     Next j
  End If
End Sub

Function resmitatil(tarih) As Boolean
  resmitatiltarih = Array("01.01.2017", "23.04.2017", "01.05.2017", "19.05.2017", "24.06.2017", "25.06.2017", "26.06.2017", "27.06.2017", "30.08.2017", "31.08.2017", "01.09.2017", "02.09.2017", "03.09.2017", "04.09.2017", "28.10.2017", "29.10.2017")
  'resmitatilisim = Array("YILBAŞI", "ULUSAL EGEMENLİK VE ÇOCUK BAYRAMI", "EMEK VE DAYANIŞMA GÜNÜ", "ATATÜRK'Ü ANMA GENÇLİK VE SPOR BAYRAMI", "RAMAZAN BAYRAMI ARİFESİ", "RAMAZAN BAYRAMI", "RAMAZAN BAYRAMI", "RAMAZAN BAYRAMI", "ZAFER BAYRAMI", "KURBAN BAYRAMI ARİFESİ", "KURBAN BAYRAMI", "KURBAN BAYRAMI", "KURBAN BAYRAMI", "KURBAN BAYRAMI", "CUMHURİYET BAYRAMI", "CUMHURİYET BAYRAMI")
  For i = LBound(resmitatiltarih) To UBound(resmitatiltarih)
     If CDate(tarih) = CDate(resmitatiltarih(i)) Then
        resmitatil = True
        Exit Function
     End If
  Next i
  resmitatil = False
End Function

TURUNCU28 · 21 Mayıs 2017

Sayın asri ellerinize emeğinize sağlık. İstirahat gününüzde ilgileniyorsunuz sorunlarımızla. benim 8 numaralı mesajıma bakabildiniz mi acaba. hala çözemedim maalesef

PLİNT · 21 Mayıs 2017

TURUNCU28' Alıntı:
Sayın asri ellerinize emeğinize sağlık. İstirahat gününüzde ilgileniyorsunuz sorunlarımızla. benim 8 numaralı mesajıma bakabildiniz mi acaba. hala çözemedim maalesef

Merhaba
5. mesajdaki değişen kodları deneyin.

pdf olarak kaydetme sorunu

TURUNCU28

Mahmut Bayram

Özel Üye

TURUNCU28

Mahmut Bayram

Özel Üye

PLİNT

TURUNCU28

Asri

TURUNCU28

TURUNCU28

Asri

TURUNCU28

PLİNT