Note: The other languages of the website are Google-translated. Back to English
Oturum aç Kaydol

Bir çalışma sayfasını PDF dosyası olarak kaydetmek ve Outlook üzerinden bir ek olarak e-postayla göndermek nasıl?

Bazı durumlarda, Outlook üzerinden bir çalışma sayfasını PDF dosyası olarak göndermeniz gerekebilir. Genellikle, çalışma sayfasını manuel olarak bir PDF dosyası olarak kaydetmeniz, ardından Outlook'unuzda ek olarak bu PDF dosyasıyla yeni bir e-posta oluşturmanız ve sonunda göndermeniz gerekir. Bunu manuel olarak adım adım elde etmek zaman alıcıdır. Bu makalede, bir çalışma sayfasını nasıl hızlı bir şekilde PDF dosyası olarak kaydedeceğinizi ve Excel'de Outlook aracılığıyla otomatik olarak bir ek olarak nasıl göndereceğinizi göstereceğiz.

Bir çalışma sayfasını PDF dosyası olarak kaydedin ve VBA kodu ile ek olarak e-postayla gönderin

Bir çalışma sayfasını PDF dosyası olarak kaydedin ve VBA kodu ile ek olarak e-postayla gönderin

Etkin çalışma sayfasını otomatik olarak bir PDF dosyası olarak kaydetmek için aşağıdaki VBA kodunu çalıştırabilir ve ardından Outlook aracılığıyla bir ek olarak e-postayla gönderebilirsiniz. Lütfen aşağıdaki işlemleri yapın.

1. PDF olarak kaydedip göndereceğiniz çalışma sayfasını açın ve ardından Ara Toplam + F11 anahtarları aynı anda açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. içinde Uygulamalar için Microsoft Visual Basic Pencere, tıklayın Ekle > modül. Ardından aşağıdaki VBA kodunu kopyalayıp Kod pencere. Ekran görüntüsüne bakın:

VBA kodu: Bir çalışma sayfasını PDF dosyası olarak kaydedin ve ek olarak e-postayla gönderin

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. Tuşuna basın. F5 kodu çalıştırmak için anahtar. İçinde Araştır iletişim kutusu, lütfen bu PDF dosyasını kaydetmek için bir klasör seçin ve ardından OK düğmesine basın.

notlar:

1. Artık aktif çalışma sayfası PDF dosyası olarak kaydedilir. Ve PDF dosyası, çalışma sayfası adıyla adlandırılır.
2. Aktif çalışma sayfası boşsa, aşağıdaki ekran görüntüsü gibi bir iletişim kutusu alacaksınız. OK düğmesine basın.

4. Şimdi yeni bir Outlook e-postası oluşturulur ve PDF dosyasının Ekli dosyasında bir ek olarak listelendiğini görebilirsiniz. Ekran görüntüsüne bakın:

5. Lütfen bu e-postayı oluşturup gönderin.
6. Bu kod yalnızca Outlook'u posta programınız olarak kullandığınızda kullanılabilir.

Bir çalışma sayfasını veya birden çok çalışma sayfasını tek seferde ayrı PDF dosyaları olarak kolayca kaydedin:

The Çalışma Kitabını Böl yarar Kutools for Excel aşağıdaki demoda gösterildiği gibi bir çalışma sayfasını veya birden fazla çalışma sayfasını ayrı PDF dosyaları olarak kolayca kaydetmenize yardımcı olabilir. Şimdi indirin ve deneyin! (30-günlük ücretsiz iz)

İlgili Makaleler:

En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yaşlılar önden
En yeni ilk
Yorumlar (62)
5 üzerinden 5 olarak derecelendirildi · 1 derecelendirme
Michael
Michael
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu benim için harika çalışıyor ancak manuel olarak seçmek yerine otomatik olarak bir klasör konumu seçmenin bir yolu var mı? Bunu bir kerede 40 sayfa için yapmayı umuyorum.
cevap
0
0
Hugh
Hugh     Michael
Bu yorum sitedeki moderatör tarafından en aza indirildi
Ayrıca bu soruna bir cevap görmeyi umuyoruz! Yardım için teşekkürler!
cevap
0
0
Darren
Darren
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu yeni bir modüle yapıştırmayı denedim ve Derleme hatası alıyorum: Alt veya İşlev tanımlanmadı. Lütfen yardım et.
cevap
0
0
kristal
kristal     Darren
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Darren,
Hangi Office sürümünü kullanıyorsunuz?
cevap
Report
0
0
Naki
Naki     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Ofis 360
cevap
0
0
Fatura
Fatura     Darren
Bu yorum sitedeki moderatör tarafından en aza indirildi
Aynı sorun
cevap
0
0
michael charry
michael charry
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yukarıdaki VBA komut dosyasını, dosya adına bir tarih ve saat damgası ekleyecek ve böylece önceden kaydedilmiş olanın üzerine yazmaya devam etmeyecek şekilde nasıl düzenlerim?
cevap
Report
0
0
kristal
kristal     michael charry
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Michael,
Lütfen sorunu çözmek için aşağıdaki VBA kodunu çalıştırın.

Alt Saveaspdfandsend()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
xStr'yi Dize Olarak Kıs

xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xStr = Format(Şimdi(), "yyyy-aa-gg-ss-aa-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + "-" + xStr + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Parag Somani
Parag Somani     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Gerçekten harika ve benim için mükemmel çalışıyor. Eklemek için daha fazla yardıma ihtiyacınız var:

1. "Kime" bölümünde, CC ve BCC'de olduğu gibi Aktif sayfanın belirli bir hücresine bağlantı vermek istiyorum, aktif sayfa bağlantısı eklemek istiyorum
2. e-posta gövdesinde standart bir metin belirtmem gerekiyor.

Yardımın için sana çok dolu olacağım.

Teşekkürler
Parag
cevap
0
0
kristal
kristal     Parag Somani
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Parag Somani,
Aşağıdaki VBA kodu size yardımcı olabilir. Lütfen .To, .CC, .BCC ve .Body alanlarını ihtiyaçlarınıza göre değiştirin.

Alt Saveaspdfandsend()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
xStr'yi Dize Olarak Kıs

xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xStr = Format(Şimdi(), "yyyy-aa-gg-ss-aa-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = Aralık("A8")
.CC = Aralık("A9")
.BCC = Aralık("A10")
.Konu = xSht.Name + "-" + xStr + ".pdf"
.Body = "Sevgili" _
& vbNewLine & vbNewLine & _
"Bu bir test e-postasıdır" & _
"Excel'de gönderme"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Mehul
Mehul     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
"Kime", "CC" için Aralığı kullanmaya çalışıyorum, sadece belirtilen hücreden değerleri almıyor. Lütfen bu konuda yardımcı olabilir misiniz?
Teşekkürler,
Mehul
cevap
0
0
Parag Somani
Parag Somani     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Gerçekten harika ve benim için mükemmel çalışıyor. Eklemek için daha fazla yardıma ihtiyacınız var:

1. "Kime" bölümünde, CC ve BCC'de olduğu gibi Aktif sayfanın belirli bir hücresine bağlantı vermek istiyorum, aktif sayfa bağlantısı eklemek istiyorum
2. e-posta gövdesinde standart bir metin belirtmem gerekiyor.

Yardımın için sana çok dolu olacağım.

Teşekkürler
Parag
cevap
0
0
Parag
Parag     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Gerçekten harika ve benim için mükemmel çalışıyor. Eklemek için daha fazla yardıma ihtiyacınız var:

1. "Kime" bölümünde, CC ve BCC'de olduğu gibi Aktif sayfanın belirli bir hücresine bağlantı vermek istiyorum, aktif sayfa bağlantısı eklemek istiyorum
2. e-posta gövdesinde standart bir metin belirtmem gerekiyor.

Yardımın için sana çok dolu olacağım.

Teşekkürler
Parag
cevap
Report
0
0
Armin
Armin
Bu yorum sitedeki moderatör tarafından en aza indirildi
Örneğin, çalışma kitabından sayfa 2'yi pdf olarak nasıl ekleyebilirim?
cevap
0
0
kristal
kristal     Armin
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Armin,
Önce çalışma kitabınızda Sayfa 2'yi açmanız ve ardından aşağı indirmek için yukarıdaki adımlarla VBA kodunu çalıştırmanız gerekir.
cevap
Report
0
0
Tom h
Tom h
Bu yorum sitedeki moderatör tarafından en aza indirildi
Dosya adının, örneğin A1 hücresi gibi geçerli sayfada seçilen belirli bir hücre olarak kaydedilmesi için yukarıdaki VBA komut dosyasını nasıl düzenlerim?
cevap
0
0
kristal
kristal     Tom h
Bu yorum sitedeki moderatör tarafından en aza indirildi
Selam tom.
Üzgünüm bu konuda yardımcı olamam.
Forumumuza herhangi bir soru göndermeye hoş geldiniz: https://www.extendoffice.com/forum.html
Excel profesyonellerinden veya diğer Excel hayranlarından daha fazla Excel desteği alacaksınız.
cevap
Report
0
0
james
james
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, pdf'yi mevcut VBA koduyla çalışma kitabı adıyla nasıl kaydedebilir ve gönderebilirim? xSht.Name yerine ne kullanırım
cevap
0
0
kristal
kristal     james
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba James,
Etkin çalışma sayfasını pdf olarak göndermek ve çalışma kitabı adı olarak adlandırmak ister misiniz?
cevap
Report
0
0
ranga
ranga
Bu yorum sitedeki moderatör tarafından en aza indirildi
Teşekkürler işe yarıyor.
cevap
0
0
Jason
Jason
Bu yorum sitedeki moderatör tarafından en aza indirildi
E-posta gönderdikten sonra kaydedilen pdf'yi silmesini nasıl sağlayabilirim?
cevap
0
0
kristal
kristal     Jason
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Jason,
Maalesef henüz bu konuda size yardımcı olamam. E-postayla gönderdikten sonra manuel olarak silmeniz gerekir.
cevap
Report
0
0
Tek-Inge
Tek-Inge
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Bir hücreden pdf adını bulmak mümkün müdür? Eski. hücre H4


Ve Hücre H4'te üç farklı hücreden toplamasını istiyorum. Mümkün mü?
cevap
0
0
Taylor
Taylor     Tek-Inge
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu mümkün. Değeri hücrelerden tutmak için ayrı değişkenler yapın ve ardından xFolder'ı ayarlarken bu değişkenleri kullanın.
Sayfamdaki bir hücrenin değerini artı bugünün tarihini kullandım. Yine de birden çok hücre değerini kolayca yapabilirsiniz.

Eklediğim şey bu:
Dim xÜyeAdı As Dize
Dim xFileDate As Dize

xMemberName = Aralık("H3").Value
xFileDate = Format(Şimdi, "aa-gg")

xFolder = xFolder + "\" xÜyeAdı + xFileDate + ".pdf"
cevap
0
0
Sora
Sora     Taylor
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunu denediğimde bir hata alıyorum, bunu kodun neresine yerleştirmeliyim?
cevap
0
0
Kishore
Kishore
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,



Gerçekten harika ve benim için mükemmel çalışıyor. Eklemek için daha fazla yardıma ihtiyacınız var:

1. "Gövde" de Aktif sayfanın belirli bir hücresine bağlantı vermek istiyorum. Ayrıca Metni Kalın yapmak istiyorum.

Teşekkürler

Saygılarımızla

Kishore Kumar
cevap
Report
0
0
kristal
kristal     Kishore
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Hücre değerini otomatik olarak posta gövdesine eklemek ve kalınlaştırmak mı istiyorsunuz? Posta gövdesine C4 değerini eklediğinizi varsayalım. Lütfen aşağıdaki kodu uygulayınız.

Alt Saveaspdfandsend()

Dim xSht As Çalışma Sayfası

Dim xFileDlg FileDialog Olarak

Dize olarak xFolder'ı karart

Dim xYesorHayır Tamsayı Olarak

Nesne olarak xOutlookObj'yi karart

Dim xEmailObj Nesne Olarak

Aralık Olarak xUsedRng Dim



xSht = ActiveSheet'i ayarla

xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın



xFileDlg.Show = True ise

xFolder = xFileDlg.SelectedItems(1)

başka

MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"

Exit Sub

Eğer son

xFolder = xFolder + "\" + xSht.Name + ".pdf"



'Dosyanın zaten var olup olmadığını kontrol edin

Len(Dir(xFolder)) > 0 ise

xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _

vbYesNo + vbQuestion, "Dosya Var")

On Error Resume Next

xYesorNo = vbYes ise

xFolder'ı öldür

başka

MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _

& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"

Exit Sub

Eğer son

Eğer Err.Number <> 0 ise

MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _

& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"

Exit Sub

Eğer son

Eğer son



xUsedRng = xSht.UsedRange olarak ayarlayın

If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra

'PDF dosyası olarak kaydet

xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard



'Outlook e-postası oluştur

xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın

xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın

xEmailObj ile

.Görüntüle

.To = ""

.CC = ""

.Konu = xSht.Name + ".pdf"

.Ekler.xFolder Ekle

.HTMLBody = "
" & Range("C4") & .HTMLBody

DisplayEmail = False ise

'.Göndermek

Eğer son

İle bitmek

başka

MsgBox "Etkin çalışma sayfası boş bırakılamaz"

Exit Sub

Eğer son

End Sub
cevap
Report
0
0
Geoff
Geoff
Bu yorum sitedeki moderatör tarafından en aza indirildi
Her seferinde belirli bir klasöre otomatik olarak kaydetmesini isteseydim (kullanıcının klasörü seçme ihtiyacını ortadan kaldırır), bunu nasıl yapardım?
Eski. C: Faturalar/Kuzey Amerika/Müşteriler
Yardım büyük beğeni topluyor.
cevap
0
0
kristal
kristal     Geoff
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Geoff,
Çalışma sayfasını bir pdf dosyası olarak kaydetmek ve göndermeden belirli bir klasöre kaydetmek mi demek istiyorsunuz?
cevap
Report
0
0
Jeremy
Jeremy     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bence Geoff, konumu manuel olarak seçmek yerine pdf'nin her seferinde kaydedildiği kodda belirli bir klasörü belirleyebilmek anlamına geliyor. Daha sonra pdf, söz konusu klasörden e-posta ile gönderilir.
cevap
0
0
kristal
kristal     Jeremy
Bu yorum sitedeki moderatör tarafından en aza indirildi
Teşekkürler Jeremy.
cevap
Report
0
0
kristal
kristal     Geoff
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Geoff, Eğer konumu manuel olarak seçmek yerine pdf dosyasını belirli bir klasöre otomatik olarak kaydetmek istiyorsanız, lütfen aşağıdaki kodu deneyin. Koddaki klasör yolunu değiştirmeyi unutmayın.
Alt SaveAsPDFandSend()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
xPath'i Dize Olarak Karartın
xSht = ActiveSheet'i ayarla
xYol = "C:\Users\Win10x64Test\Desktop\çalışma sayfasından pdf'ye" 'burada "çalışma sayfası pdf", pdf dosyalarının kaydedileceği hedef klasördür
xFolder = xPath + "\" + xSht.Name + ".pdf"
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Alison
Alison
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kod, çalışma sayfasının sayfa adı + tarih olarak kaydedilmesini istemem dışında harika çalışıyor (yani, Sayfa1 Ekim 1 2020); kullanıcının masaüstünde (bu, birden fazla kişi tarafından kullanılacaktır ve yolları biraz değişebilir). Mümkünse, gövdeye de bir .jpg gömmek istiyorum.. JPG hem çalışma sayfasının içinde (baskı alanının dışında) hem de görüntü paylaşılan bir sunucuda saklanır.. kullanıcı (çoğu için bir "T" sürücüsüdür, bazıları için bir "U" sürücüsüdür)
bu yapılabilir mi? lütfen ve milyonlarca kez teşekkür ederim.
cevap
0
0
Deepak
Deepak
Bu yorum sitedeki moderatör tarafından en aza indirildi

Merhaba, harika çalışıyor, paylaştığınız için teşekkürler, Sadece bir yardıma ihtiyacım var.
Bir PDF dosyasını özelleştirilmiş adla kaydetmek istersem (SaveAs iletişim kutusuna dosya adını yazma seçeneği), kullanıcı bu seçeneği formların benzersiz adla PDF olarak kaydedildiği form şablonunda kullanır.
cevap
Report
0
0
kristal
kristal     Deepak
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Lütfen aşağıdaki VBA kodunu deneyin. Kodu çalıştırdıktan sonra, PDF dosyasını kaydetmek için bir klasör seçin, ardından dosya adını girmeniz için bir iletişim kutusu açılacaktır. Alt Saveaspdfandsend()
'Tarafından güncellendi Extendoffice 20210209
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
Dize Olarak Dim xStrName
Dim xV Varyant Olarak

xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xStrName = ""
xV = Application.InputBox("Lütfen dosya adını girin:", "Kutools for Excel", , , , , , 2)
xV = Yanlış ise
Exit Sub
Eğer son
xStrAdı = xV
xStrName = "" ise
MsgBox ("Dosya adı girilmedi, işlemden çıkılıyor!")
Exit Sub
Eğer son

xFolder = xFolder + "\" + xStrName + ".pdf"
'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
meczus94
meczus94
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Dosyamda iki sayfa varsa ve bu makroyu bir sayfada (düğmesine basarak) çalıştırıp başka bir sayfa göndermek istersem, nasıl alabilirim?
cevap
Report
0
0
ha
ha
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bunu C30 hücresindeki değere göre belirli bir dosya konumuna kaydetmek istiyorum. Birkaç seçenek denedim, ancak hata almaya devam ediyorum.
cevap
0
0
kristal
kristal     ha
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba hein, Aşağıdaki kod belki yardımcı olabilir. Kodu çalıştırdıktan sonra, PDF dosyasını kaydetmek için belirli bir klasör seçin, ardından dosya adını girmeniz için bir iletişim kutusu açılır. Alt Saveaspdfandsend()
'Tarafından güncellendi Extendoffice 20210209
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
Dize Olarak Dim xStrName
Dim xV Varyant Olarak

xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xStrName = ""
xV = Application.InputBox("Lütfen dosya adını girin:", "Kutools for Excel", , , , , , 2)
xV = Yanlış ise
Exit Sub
Eğer son
xStrAdı = xV
xStrName = "" ise
MsgBox ("Dosya adı girilmedi, işlemden çıkılıyor!")
Exit Sub
Eğer son

xFolder = xFolder + "\" + xStrName + ".pdf"
'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Hein
Hein     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunun için teşekkürler, bu harika, ancak sayfanın sayfa 1'deki A1 hücresine göre adlandırılmasını istiyorum. Sayfa 1'deki A2'e göre kaydedilecek yer, örneğin C:\ A3 sayfası 2'deki e-posta adresini zaten çözdüm.
cevap
0
0
HeinPeeters
HeinPeeters     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bunun için teşekkürler, bu harika, ancak sayfanın 1. sayfadaki A1 hücresine göre adlandırılmasını istiyorum. 1. sayfada A2'e göre kaydedilecek yer, örneğin C:\Users\peete\Dropbox\Screenshots, ancak dosyayı kullanarak ve e-postayı A3 sayfa 2'deki e-posta adresine gönder, zaten çalıştığım şeyi.
cevap
Report
0
0
BenSpo
BenSpo
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hi kristal , mükemmel kod, paylaşım için teşekkürler. Her birini bağımsız bir PDF olarak kaydetmek ve ardından hepsini tek bir e-postaya ekli olarak göndermek için (aynı çalışma kitabından) birden çok sayfa seçmenin bir yolu var mı?
cevap
Report
0
0
kristal
kristal     BenSpo
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Aşağıdaki VBA kodu size bir iyilik yapabilir, lütfen bir deneyin. Kodun on ikinci satırında, lütfen durumunuzdaki sayfa adlarını gerçek sayfa adlarıyla değiştirin.
Alt Saveaspdfandsend1()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır, I, xNum As Integer
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
Varyant Olarak Dim xArrShetts
xPDFNameAddress'i Dize Olarak Karart
xStr'yi Dize Olarak Kıs
xArrShetts = Dizi("Ölçek", "Sayfa1", "Sayfa2") 'Pdf dosyası olarak göndereceğiniz sayfa adlarını tırnak içine alın ve virgülle ayırın. Dosya adında \/:"*<>| gibi özel karakterler bulunmadığından emin olun.

I = 0 için UBound(xArrShetts) için
On Error Resume Next
xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) olarak ayarlayın
Eğer xSht.Name <> xArrShetts(I) O zaman
MsgBox "Çalışma sayfası bulunamadı, çıkış işlemi:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Eğer son
Sonraki


xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın
xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
'Dosyanın zaten var olup olmadığını kontrol edin
xYesorNo = MsgBox("Hedef klasörde aynı ada sahip dosyalar varsa, çiftleri ayırt etmek için dosya adına otomatik olarak numara eki eklenecektir" & vbCrLf & vbCrLf & "Devam etmek için Evet'i, iptal etmek için Hayır'ı tıklayın", _
vbYesNo + vbQuestion, "Dosya Var")
Eğer xYesorNo <> vbYes ise Sub Exit
I = 0 için UBound(xArrShetts) için
xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) olarak ayarlayın

xStr = xFolder & "\" & xSht.Name & ".pdf"
xSayı = 1
Değilken (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xSayı = xSayı + 1
uygulamak
xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xStr, Quality:=xlQualityStandard
başka

Eğer son
xArrShetts(I) = xStr
Sonraki

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = "????"
I = 0 için UBound(xArrShetts) için
.Ekler.xArrShetts(I) ekleyin
Sonraki
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
End Sub
cevap
Report
0
0
Berne Rudolph
Berne Rudolph     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Mücadele ettiğim tek değişiklik, oluşturulan her pdf belgesi için ayrı bir e-posta oluşturmak.
cevap
0
0
kristal
kristal     Berne Rudolph
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Her pdf belgesi için ayrı bir e-posta oluşturmak için, bunu yapmak için gönderide sağlanan VBA'yı farklı çalışma sayfalarında manuel olarak çalıştırabilirsiniz.
cevap
Report
0
0
Berne Rudolph
Berne Rudolph     kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çalışma kitabında 100'den fazla çalışma sayfam var, bu da VBA'yı 100 defadan fazla çalıştırmam gerektirecek ve bu da zaman alıcı.  
Çalışma kitabımı birden çok sayfaya bölmeyi başardım ve ardından her çalışma sayfasını ayrı bir PDF belgesine dönüştürebiliyorum.
Aradığım çözüm, yukarıdaki süreç çalışırken her bir PDF belgesini ayrı ayrı e-posta ile göndermek.
Şu anda çalıştırdığım VBA ile:
Alt Saveaspdfandsend1()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır, I, xNum As Integer
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
Varyant Olarak Dim xArrShetts
xPDFNameAddress'i Dize Olarak Karart
xStr'yi Dize Olarak Kıs
xArrShetts = Dizi("02302257", "02400438", "02401829", "02403995", "02408001", "02409208", _
"02409980", "02411881", "02424178", "02430454", "02444046", "02448950", "02450600", _
"02459861", "02461750", "02467535", "02480484", "02484749", "02502041", "02504807", _
"02511843", "02515193", "02523098", "02523244", "02524036", "02524548", "02525516", "02525703", "02525898", "02528908", "02528950", _
"02530381", "02531018", "02531252", "02531277", "02532571", "02533053", "02533474", _
"02534176", "02534592", "02534626", "02535343", "02536386", "02536921", "02537544", _
"02537607", "02538015", "02538755", "02538836", "02538910", "02539685", "02540063", "02540139", "02540158", "02541607", "02542344", _
"02543763", "02543985", "02544116", "02544748", "02544762", "02545026", "02545048", _
"02545080", "02545447", "02545730", "02545814", "02546477", "02547458", "02547673", _
"02547833", "02547912", "02547950", "02547991", "02548848", "02549103", "02549116", "02549125", "02549132", "02549140", "02549182", _
"02549462", "02549499", "02549565", "02549687", "02550049", "02550437", "02550812", _
"02550982", "02551004", "02551005", "02551045", "02552099", "02552222", "02552561", _
"02552684", "02552815", "02552892", "02553031", "02553186", "02553628", "02553721", "02555186", "02556934", "02557137", "02557393", _
"02559121", "02559392", "02559419", "02559512", "02559802", "02559868", "02560052", _
"02560612", "02560684", "02560920", "02561018", "02561061", "02561092", "02561227", _
"02561349", "02561592", "02561630", "02561673", "02561880", "02562359", "02562920", "02562934", "02563013", "02563119", "02563133", _
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Pdf dosyası olarak göndereceğiniz sayfa adlarını tırnak içine alın ve virgülle ayırın. Dosya adında \/:"*<>| gibi özel karakterler bulunmadığından emin olun.

I = 0 için UBound(xArrShetts) için
On Error Resume Next
xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) olarak ayarlayın
Eğer xSht.Name <> xArrShetts(I) O zaman
MsgBox "Çalışma sayfası bulunamadı, çıkış işlemi:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
Eğer son
Sonraki


xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın
xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
'Dosyanın zaten var olup olmadığını kontrol edin
xYesorNo = MsgBox("Hedef klasörde aynı ada sahip dosyalar varsa, çiftleri ayırt etmek için dosya adına otomatik olarak numara eki eklenecektir" & vbCrLf & vbCrLf & "Devam etmek için Evet'i, iptal etmek için Hayır'ı tıklayın", _
vbYesNo + vbQuestion, "Dosya Var")
Eğer xYesorNo <> vbYes ise Sub Exit
I = 0 için UBound(xArrShetts) için
xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I)) olarak ayarlayın

xStr = xFolder & "\" & xSht.Name & ".pdf"
xSayı = 1
Değilken (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xSayı = xSayı + 1
uygulamak
xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xStr, Quality:=xlQualityStandard
başka

Eğer son
xArrShetts(I) = xStr
Sonraki

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Konu = "????"
I = 0 için UBound(xArrShetts) için
On Error Resume Next
.Ekler.xArrShetts(I) ekleyin
Sonraki
DisplayEmail = False ise
`s
Exit Sub
Eğer son
İle bitmek


End Sub
cevap
0
0
Tori
Tori
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba @kristal
Bu harika - uğraştığım o anahtar şey dosya adı - sekme adını kullanmak yerine dosya adının çalışma sayfasındaki bir hücreden çekilmesini istiyorum. Kodu, belirtilen bir klasöre otomatik olarak kaydetmek için zaten düzenledim ancak dosya adıyla mücadele ediyorum.
Sunabileceğiniz herhangi bir yardım lütfen?
cevap
0
0
kristal
kristal     Tori
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Tori, PDF dosyasına belirli bir hücre değeri vermek istiyorsanız, lütfen aşağıdaki kodu deneyin. Kodu çalıştırdıktan ve dosyayı kaydetmek için bir klasör seçtikten sonra, başka bir iletişim kutusu açılır, lütfen kullanacağınız hücreyi seçin. değeri PDF dosyasının adı olarak seçin ve ardından bitirmek için Tamam'a tıklayın.
Alt Saveaspdfandsend2()
'Tarafından güncellendi Extendoffice 20210521
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Dim xUsedRng, xRgInser As Aralık
Dim xB Boole Olarak
xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xB = Doğru
On Error Resume Next
xB iken
xRgInser'ı ayarla = Hiçbir şey
Set xRgInser = Application.InputBox("PDF dosyasını adlandırmak için değeri kullanacağınız bir hücre seçin:", "Kutools for Excel", , , , , , 8)
Eğer xRgInser Hiçbir Şey Değilse
MsgBox "Hücre seçilmedi, işlemden çıkın!", vbInformation, "Kutools for Excel"
Exit Sub
Eğer son
xRgInser.Text = "" ise
MsgBox " Seçilen hücre boş, lütfen yeniden seçin! ", vbInformation, "Kutools for Excel"
başka
xB = Yanlış
Eğer son
uygulamak

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Makeeuropeanu
Makeeuropeanu
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, buna benzer bir şeye ihtiyacım vardı, işte elimdeki bu. Geçerli tarihi alır ve belirli bir konumda tarih adıyla yeni bir klasör oluşturur. pdf'yi bu yeni konuma yerleştirir, ardından pdf'yi yeni bir e-postaya ekler. Bir tedavi olarak çalışır. Ben sadece bir acemiyim, bu yüzden bir karışıklık gibi görünüyorsa lütfen kusura bakmayın. :D
Alt PDFTOEMAIL()
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
xPath'i Dize Olarak Karartın
Dize Olarak Dim xOutMsg
sFolderName'i String Olarak, sFolder'ı String Olarak Karartın
Dize Olarak sFolderPath'i Dim

xSht = ActiveSheet'i ayarla
xFileDate = Format(Şimdi, "gg-aa-yyyy")
sFolder = "C:" 'burada bir ana klasörünüz var
sFolderName = "Hafta sonu" + Format(Şimdi, "gg-aa-yyyy") 'klasörü, ana klasörde Hafta sonu ve geçerli tarih adıyla oluşturulacak
sFolderPath = "C:" & sFolderName 'ana klasörü, yeni klasörü içeren yeni yolu oluşturmak için tekrar
Set oFSO = CreateObject("Scripting.FileSystemObject")
Eğer oFSO.FolderExists(sFolderPath) O zaman
MsgBox "Klasör zaten var!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "BİLGİ"
başka
MkDir sFolderPath
MsgBox "Yeni klasör oluşturuldu !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "BİLGİ"
Eğer son
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xOutMsg = " Lütfen ekte bulun Bu e-posta ve ek otomatik olarak oluşturuldu "
'e-postanın otomatik olarak oluşturulduğuna dair bir not ekler

xEmailObj ile
.Görüntüle
.To = "" 'kendi e-postalarınızı ekleyin
.CC = ""
.Konu = xSht.Name + " Hafta sonu için PDF " + xFileDate + " - Konum " ' konusu sayfa adını, pdf'yi, tarihi ve konumu içerir, bu gerektiğinde düzenlenebilir
.Ekler.xFolder Ekle
.HTMLBody = xOutMsg & .HTMLBody
DisplayEmail = False ise
'.Gönder <--- Burada kesme işaretini silerseniz e-posta otomatik olarak gönderilir, bu yüzden lütfen dikkatli olun
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
Report
0
0
Nicole
Nicole
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kodu yalnızca hücreleri ("a1:r99") ve PDF olarak kaydetmek üzere nasıl düzenlerim. PDF belgemde istemediğim kenarlarda fazladan şeyler var.
Alt Saveaspdfandsend()
'Tarafından güncellendi Extendoffice 20210209
Dim xSht As Çalışma Sayfası
Dim xFileDlg FileDialog Olarak
Dize olarak xFolder'ı karart
Dim xYesorHayır Tamsayı Olarak
Nesne olarak xOutlookObj'yi karart
Dim xEmailObj Nesne Olarak
Aralık Olarak xUsedRng Dim
Dize Olarak Dim xStrName
Dim xV Varyant Olarak

xSht = ActiveSheet'i ayarla
xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) olarak ayarlayın

xFileDlg.Show = True ise
xFolder = xFileDlg.SelectedItems(1)
başka
MsgBox "PDF'yi kaydetmek için bir klasör belirtmelisiniz." & vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Hedef Klasörü Belirtilmelidir"
Exit Sub
Eğer son
xStrName = ""
xV = Application.InputBox("Lütfen dosya adını girin:", "Kutools for Excel", , , , , , 2)
xV = Yanlış ise
Exit Sub
Eğer son
xStrAdı = xV
xStrName = "" ise
MsgBox ("Dosya adı girilmedi, işlemden çıkılıyor!")
Exit Sub
Eğer son

xFolder = xFolder + "\" + xStrName + ".pdf"
'Dosyanın zaten var olup olmadığını kontrol edin
Len(Dir(xFolder)) > 0 ise
xYesorNo = MsgBox(xFolder & " zaten var." & vbCrLf & vbCrLf & "Üzerine yazmak istiyor musunuz?", _
vbYesNo + vbQuestion, "Dosya Var")
On Error Resume Next
xYesorNo = vbYes ise
xFolder'ı öldür
başka
MsgBox "Mevcut PDF'nin üzerine yazmazsanız devam edemem." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Makrodan Çıkılıyor"
Exit Sub
Eğer son
Eğer Err.Number <> 0 ise
MsgBox "Mevcut dosya silinemiyor. Lütfen dosyanın açık veya yazma korumalı olmadığından emin olun." _
& vbCrLf & vbCrLf & "Bu makrodan çıkmak için Tamam'a basın.", vbCritical, "Dosya Silinemiyor"
Exit Sub
Eğer son
Eğer son

xUsedRng = xSht.UsedRange olarak ayarlayın
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Sonra
'PDF dosyası olarak kaydet
xSht.ExportAsFixedFormat Tür:=xlTypePDF, Dosya Adı:=xFolder, Quality:=xlQualityStandard

'Outlook e-postası oluştur
xOutlookObj = CreateObject("Outlook.Application") olarak ayarlayın
xEmailObj = xOutlookObj.CreateItem(0) olarak ayarlayın
xEmailObj ile
.Görüntüle
.To = ""
.CC = ""
.Konu = xSht.Name + ".pdf"
.Ekler.xFolder Ekle
DisplayEmail = False ise
'.Göndermek
Eğer son
İle bitmek
başka
MsgBox "Etkin çalışma sayfası boş bırakılamaz"
Exit Sub
Eğer son
End Sub
cevap
0
0
RLF
RLF     Nicole
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu kodu çalışma sayfalarımdan birinde denedim ve yazdırma alanları ayarladım, böylece alttaki ekstra şeyler pdf'de görünmüyordu. Dene!
cevap
0
0
Çubuk Bennett
Çubuk Bennett
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hi
Kod için çok teşekkürler ama PDF'yi otomatik olarak etkin Excel dosyasıyla aynı konuma ve etkin Excel dosyasıyla aynı dosya adıyla kaydetmek mümkün müdür?
Çok teşekkürler.
Çubuk
cevap
0
0
Buraya henüz hiç yorum yapılmamış
Daha Çok
Lütfen yorum yazın
Konuk
Misafir olarak yayınlama
Giriş
×
Bu gönderiyi değerlendirin:
Reset
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır