Kapalı Dosyayı PDF olarak kaydetme hakkında..

yesimgurol · 2 Kasım 2017

Merhabalar,
Daha önce burada oluşturulan hali hazırdaki kod , excel sayfasını PDF olarak sıkıntısız kayıt edebilmekte. Yalnız işler çoğalınca da yeni istekler baş göstermeye başlıyor. Şöyle ki, hasta raporlarımı normal excel de hazırlayıp çıktısını alıyorum ve ilgili kişilere imzalatıp veriyorum. Ama bazılarını da imzalı şekilde tarayıcıdan taratıp pdf formatında mail atıyorum. Her sayfayı tek tek tarayıcıdan geçirmem hayli zamanımı alıyor. bende ilgili kişilerin imzalarını taratıp resim olrak rapor formatı isimli dosyaya ekleyip, şöyle bir şey düşündüm ;

Bütün dosyaların aynı klasörde olması şartı ile ;
-"RAPOR FORMATI" isimli çalışma kitabının "RAPOR" isimli sayfasında bulunan ".jpeg" formatındaki resimleri aynı şekilde klasör içindeki diğer kapalı dosyalara ekleyerek "pdf" formatında kaydetmek istemeteyim.

yesimgurol · 3 Kasım 2017

Kod:

Sub KOD()
Sheets("RAPOR").Shapes("4 Resim").OLEFormat.Object.PrintObject = False
    Sheets("RAPOR").PrintOut
    Sheets("RAPOR").Shapes("4 Resim").OLEFormat.Object.PrintObject = True
    sor2 = MsgBox("PDF Dosyası Kaydetmek İstiyor Musunuz ? ", vbYesNo)
    If sor2 = vbNo Then Exit Sub
    
    'yol = "C:\Users\usr\Desktop\num kabul\uuuu\f"
    yol = "C:\Users\usr\Desktop\num kabul\uuuu\f"
    isim = Range("b6").Value
    
    Dim Fs As Object
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Fs.FileExists(yol & "/" & isim & ".pdf") Then
        sor = MsgBox("Dosya Var Yinede Devam Etmek İstiyor Musunuz ? ", vbYesNo)
        If sor = vbNo Then Exit Sub
    Else
    End If
    
    Sheets("RAPOR").Select
    ActiveSheet.Range("A2:H108").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "/" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
    
    
End Sub

Merhabalar bu kodlar da ise, imzaları içeren resimler sayfa da görünüyor. Butona bastığımda çıktı alırken resimler çıkmıyor fakat PDF olarak kaydederken resimli şekilde kayıt yapıyor.

Acaba bu kodlar üzerinde şöyle bir revize yapılabilir mi ;
sayfayı açtığımda imzaların olduğu resim görünmesin gizli olsa,o resimler arka planda PDF içinde görünse:-(

yesimgurol · 3 Kasım 2017

2.mesajımdaki kodlarda acaba imzaları içeren resimler excel açıkken gizlenebilir mi?:-(

leumruk · 3 Kasım 2017

Selamlar,

Kod:

Sub KOD()

    sor2 = MsgBox("PDF Dosyası Kaydetmek İstiyor Musunuz ? ", vbYesNo)
    If sor2 = vbNo Then Exit Sub
    
    'yol = "C:\Users\usr\Desktop\excel denemeler\num kabul\uuuu\f"
    yol = "C:\Users\Mustafa Altun\Desktop\Yeni klasör (2)"
    isim = Range("b6").Value
    
    Dim Fs As Object
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Fs.FileExists(yol & "/" & isim & ".pdf") Then
        sor = MsgBox("Dosya Var Yinede Devam Etmek İstiyor Musunuz ? ", vbYesNo)
        If sor = vbNo Then Exit Sub
    Else
    End If
    
    Sheets("RAPOR").Select
    ActiveSheet.Shapes.Range("9 Resim").Visible = False
    ActiveSheet.Range("A2:H108").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "\" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
    ActiveSheet.Shapes.Range("9 Resim").Visible = True
    
End Sub

yesimgurol · 3 Kasım 2017

Mustafa bey öncelikle ilginize çok teşekkür ederim. Kodlarınızı ekleye bildim. Denediğimde ise "9 Resim" excelde görülüyor ve PDF olarak kaydedildiğinde kayboluyor.

İstediğim aslında ters olacaktı:-( Şöyle ki;
"9 Resim" ve "8 Resim" excel açıkken görünmesin ama butona bastığımda PDF dosyasında olsun.
Aslında bu ikinci alternatifimdi.
Sanırım 1.mesajımdaki daha zor olacağını düşündüğüm için böyle bir çözüm bulmuştum.

askm · 3 Kasım 2017

Workboox open olayına
ActiveSheet.Shapes.Range("8 Resim").Visible = False
ActiveSheet.Shapes.Range("9 Resim").Visible = False
yazın
Pdf kayıt kodlarınızdan önce de true yapın değeri.

leumruk · 3 Kasım 2017

Kod:

Sub gizle()
ActiveSheet.Shapes.Range("9 Resim").Visible = False
ActiveSheet.Shapes.Range("8 Resim").Visible = False
End Sub

Bu kodu kullanarak resimleri gizleyebilirsiniz.
Asıl kodunuz için:

Kod:

Sub KOD()

    sor2 = MsgBox("PDF Dosyası Kaydetmek İstiyor Musunuz ? ", vbYesNo)
    If sor2 = vbNo Then Exit Sub
    
    'yol = "C:\Users\usr\Desktop\excel denemeler\num kabul\uuuu\f"
    yol = "C:\Users\Mustafa Altun\Desktop\Yeni klasör (2)"
    isim = Range("b6").Value
    
    Dim Fs As Object
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Fs.FileExists(yol & "/" & isim & ".pdf") Then
        sor = MsgBox("Dosya Var Yinede Devam Etmek İstiyor Musunuz ? ", vbYesNo)
        If sor = vbNo Then Exit Sub
    Else
    End If
    
    Sheets("RAPOR").Select
    ActiveSheet.Shapes.Range("9 Resim").Visible = True
    ActiveSheet.Shapes.Range("8 Resim").Visible = True
    ActiveSheet.Range("A2:H108").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "\" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
    ActiveSheet.Shapes.Range("9 Resim").Visible = False
    ActiveSheet.Shapes.Range("8 Resim").Visible = False
    
End Sub

Bir de resimleri ayrı bir klasöre kaydederek yazdırma anında çağırma seçeneği var. İsterseniz öyle bir kod da hazırlayabiliriz.

yesimgurol · 3 Kasım 2017

Mustafa bey

Kontrol ettim şimdide orjinal raporlar üzerinde deneme yapacaktım. Fakat alttaki mesajınızı da görünce "Bir de resimleri ayrı bir klasöre kaydederek yazdırma anında çağırma seçeneği var. İsterseniz öyle bir kod da hazırlayabiliriz." doğrusu o şekilde olur diye düşündü isem de bu seferde resimlerin sayfadaki yerlerini belirlemede sıkıntı olur diye yeniden kodları düzenlemek adına sizin de vaktinizden çalmak istemedim inanın.
Bu şekilde kontrol edeyim bakalım nasıl oldu..
Çok ama çok teşekkür ederim ilginiz için..:bravo::dua2::mutlu::mutlu:

leumruk · 3 Kasım 2017

Rapor2 adlı dosyada deneme yaptım. Kendinize uyarlarsınız.
yol tanımı kendi bilgisayarıma göre kendi yolunuzu tanımlayınız. Klasörü olduğu gibi ekliyorum. Resmi paintten orijinal boyutuna göre eklediğim için sayfada sıkıntı olmadı. Ama kodla boyutlandırmakta mümkün.

Kod:

Sub KOD()

    sor2 = MsgBox("PDF Dosyası Kaydetmek İstiyor Musunuz ? ", vbYesNo)
    If sor2 = vbNo Then Exit Sub
    
    'yol = "C:\Users\usr\Desktop\excel denemeler\num kabul\uuuu\f"
    yol = "C:\Users\Mustafa Altun\Desktop\Yeni klasör (2)"
    isim = Range("b6").Value
    
    Dim Fs As Object
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Fs.FileExists(yol & "/" & isim & ".pdf") Then
        sor = MsgBox("Dosya Var Yinede Devam Etmek İstiyor Musunuz ? ", vbYesNo)
        If sor = vbNo Then Exit Sub
    Else
    End If
    
    Sheets("RAPOR").Select
    ActiveSheet.Pictures.Delete
    Range("A46").Select
    ActiveSheet.Pictures.Insert (yol & "\imza.jpg")
    Range("A102").Select
    ActiveSheet.Pictures.Insert (yol & "\imza.jpg")
    
    ActiveSheet.Range("A2:H108").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "\" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
    
End Sub

yesimgurol · 3 Kasım 2017

Mustafa Bey,
Bir önceki düzenlediğiniz kodları orjinal raporlarım da uyguladım. Şimdilik herhangi bir sorun olmadı. :bravo::mutlu::mutlu:

Son eklemiş olduğunuz klasörü de denedim fakat sanırım yanlış yapmış da olabilirim:-(
PDF dosyasında resmi en üstte olacak şekilde kaydetmiş. Ama inanın mahcupda oluyorum. Gerçekten çok teşekkür ederim ilginize..Bir önceki yapmış olduğunuz şekilde kullanmaya başlayacağım inşaallah, ay çok mutlu oldum yaaa:mutlu::mutlu:

:hey:

leumruk · 3 Kasım 2017

Rica ederim. Ancak 2. kod yapacağınız iş için bence daha uygun. Hücre seçim kodlarını doğru yazdığınıza emin olun. Bir de sayfanızda buton veya silinmesini istemediğiniz herhangi bir resim yoksa kodunuza resim silme satırını da ekleyiniz. Ben üstteki mesajıma bu kodu da ekleyeceğim yerine oradan bakabilirsiniz. Eğer sayfada başka nesneler varsa döngü ile resim temizleme makrosu eklemeliyiz. O kod için sayfanızdaki resimlerin adı gerekli.

Kod:

ActiveSheet.Pictures.Delete

yesimgurol · 3 Kasım 2017

Mustafa Bey,
Yeniden denedim şöyle ki ,
Öncelikle Orjinal raporlarımda "Pıcture1" adında iki adet nesne mevcut imzayı içeren resimler haricinde..
Son düzenleme ile denediğimde PDF dosyasında eklenecek olan resimler en üstte oluyor ve butona bastıktan sonra excel sayfasını da kontrol ettiğimde eklenecek olan resmin ikisi de en üstte gelmiş oluyor.:roll:

leumruk · 3 Kasım 2017

Bende yaşadığınız sıkıntı olmadı. Yine de kodu revize ettim. Resim boyutlandırma ve konumlandırma satırları ekledim.
Resim silme kodunu da ismi belirtilen resmin silinmesini engelleyecek şekilde düzenledim. Bu kodlamayı kodun en sonuna da ekleyerek kayıt işleminden sonra gelen resimlerin silinmesini sağlayabilirsiniz.
Silme koduna silinmesini istemediğiniz resmin ismini yazınız.
NOT: Yaşadığınız sorun ben de yaşanmadığı için başka alternatif üretemiyorum. Benim yapabileceklerim bu kadar.

Kod:

Sub KOD()
    sor2 = MsgBox("PDF Dosyası Kaydetmek İstiyor Musunuz ? ", vbYesNo)
    If sor2 = vbNo Then Exit Sub
    
    'yol = "C:\Users\usr\Desktop\excel denemeler\num kabul\uuuu\f"
    yol = "C:\Users\Mustafa Altun\Desktop\Yeni klasör (2)"
    isim = Range("b6").Value
    
    Dim Fs As Object
    Set Fs = CreateObject("Scripting.FileSystemObject")
    If Fs.FileExists(yol & "/" & isim & ".pdf") Then
        sor = MsgBox("Dosya Var Yinede Devam Etmek İstiyor Musunuz ? ", vbYesNo)
        If sor = vbNo Then Exit Sub
    Else
    End If
   Sheets("RAPOR").Select
    For Each rsm In ActiveSheet.Pictures
    If rsm.Name <> "Picture1" Then
    rsm.Delete
    End If
    Next
   Range("A46").Select
    With ActiveSheet.Pictures.Insert(yol & "\imza.jpg")
    .ShapeRange.Height = 48
    .ShapeRange.Width = 765
    .Left = Range("A46").Left
    .Top = Range("A46").Top
    End With
    Range("A102").Select
    With ActiveSheet.Pictures.Insert(yol & "\imza.jpg")
    .ShapeRange.Height = 48
    .ShapeRange.Width = 765
    .Left = Range("A102").Left
    .Top = Range("A102").Top
    End With
    
    ActiveSheet.Range("A2:H108").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "\" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
    
End Sub

yesimgurol · 3 Kasım 2017

Mustafa bey , çok ama çok teşekkür ederim. Çok işime yaradı inanın ki..Kolay gelsin sizlere de..

leumruk · 3 Kasım 2017

yesimgurol' Alıntı:
Mustafa bey , çok ama çok teşekkür ederim. Çok işime yaradı inanın ki..Kolay gelsin sizlere de..

Rica ederim.

Kapalı Dosyayı PDF olarak kaydetme hakkında..

yesimgurol

Ekli dosyalar

yesimgurol

yesimgurol

leumruk

Uzman

yesimgurol

askm

Destek Ekibi

leumruk

Uzman

yesimgurol

leumruk

Uzman

Ekli dosyalar

yesimgurol

leumruk

Uzman

yesimgurol

leumruk

Uzman

yesimgurol

leumruk

Uzman