pdf sıkıştırma

[mesutaygun70]

Benim dosyayı pdf'e çeviren aşağıdaki gibi bir kodum var. Bu pdf dosyasınıda programa yüklüyorum. Fakat program pdf dosyası olması gerekenden 44 kb büyük diye uyarı veriyor. Online pdf sıkıştırma programlarını kullanarak her seferinde sıkıştırma yapıyorum. Bu sıkıştırmayı kod yardımıyla yapamazmıyız.

Sub PDFHASTALIKFORM()
SAY = 0
For i = 1 To 1
SAY = SAY + 1
yer = Sheets("HAST").Select
Range("a2:I39").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\USER\Belgeler\EBYS İZİN\form hastalık" & " " & Sheets("yıl").[ı13] & " " & Sheets("yıl").[C6] & " " & Sheets("yıl").[C7] & sayfaadi & uzantı, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End Sub

 

[mesutaygun70]

güncel konu

 

[halit3]

Bu kodu bir dene

#If VBA7 Then
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Sub PDFHASTALIKFORM()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


yol = [COLOR="Red"]"c:\"[/COLOR]
isim = [COLOR="red"]"deneme"[/COLOR]

say = 0
For i = 1 To 1
say = say + 1
yer = Sheets("HAST").Select
Range("a2:I39").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\USER\Belgeler\EBYS İZİN\form hastalık" & " " & Sheets("yıl").[ı13] & " " & Sheets("yıl").[C6] & " " & Sheets("yıl").[C7] & sayfaadi & uzantı, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next


'WinRar uygulamasının tam yolunu yazın
Program_Yolu = yol & "Program Files\WinRAR\WinRAR.exe"

If Dir(Program_Yolu) = "" Then
MsgBox "Sisteminizde yüklü WinRAR sıkıştırma programını bulunamamıştır !" & vbCrLf & "Lütfen daha sonra tekrar deneyiniz !", vbCritical, "Dikkat !"
Exit Sub
End If

Dosya_Adı = yol & isim & ".pdf"

Arşiv_Dosya_Adı = yol & isim

'Rar dosyası oluşturuluyor
ShellExecute 0, "Open", Program_Yolu, "a " & Arşiv_Dosya_Adı & " " & Dosya_Adı, "", vbHide

Application.Wait Now + TimeValue("00:00:02")

Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")

fs.MoveFile yol & isim & ".rar", ThisWorkbook.Path & "\" & isim & ".rar"
fs.DeleteFile Dosya_Adı, True

Application.ScreenUpdating = True
Application.DisplayAlerts = True


MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

kırmızı yerleri kendin değiştir.

 

[askm]

Halit Hocam Mesut Beyin istediği rar veya zip ile sıkıştırma değil sanırım. Belgeyi yükleyeceği site pdf evrak istiyor diye biliyorum. https://smallpdf.com/tr/compress-pdf tarzı sitelerin pdf evrağın çözünürlüğünü düşürerek yapmış olduğu boyut küçültme işlemini istiyor.
Bu işlem için excelde pdf kaydetmede çözünürlük ayarı yok.

 

[Korhan Ayhan]

Merhaba,

Kullandığınız kod içindeki aşağıdaki satır zaten dosyayı minimum boyut olarak PDF formatına çeviriyor.

Quality:=xlQualityMinimum

 

[askm]

Korhan Bey. Herhangi bir sayfayı sadece bir hücrede A yazıp bu şekilde pdf yapınca 130 - 140 kb oluyor. https://smallpdf.com/tr/compress-pdf ile sıkıştırdığınızda 15 kb civarına düşüyor. Bende yapmaya çalıştım ama olmadı.
Sanırım yapılacak işlem web sayfası + pdf kaydetme işlemi şeklinde yapılmalı. Önce pdf evrak kaydedilip. Çevirmek istediği sayfadan bu evrak seçilerek sıkıştırılmalı.

 

[askm]

Sayın Mesut Bey. Pdf sıkıştırmak için kullandığınız linki paylaşabilirseniz, bu siteye otomatik gönderip sıkıştırmayı deneyebiliriz.

 

[mesutaygun70]

https://smallpdf.com/tr/compress-pdf
sayfasından dosya ekleme yapıyorum. Emeği geçen arkadaşlara teşekkürler.