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

วิธีบันทึกแผ่นงานเป็นไฟล์ PDF และส่งอีเมลเป็นไฟล์แนบผ่าน Outlook?

ในบางกรณีคุณอาจต้องส่งแผ่นงานเป็นไฟล์ PDF ผ่าน Outlook โดยปกติคุณจะต้องบันทึกแผ่นงานเป็นไฟล์ PDF ด้วยตนเองจากนั้นสร้างอีเมลใหม่โดยใช้ไฟล์ PDF นี้เป็นไฟล์แนบใน Outlook ของคุณและส่งไปในที่สุด การทำทีละขั้นตอนด้วยตนเองใช้เวลานาน ในบทความนี้เราจะแสดงวิธีบันทึกแผ่นงานเป็นไฟล์ PDF อย่างรวดเร็วและส่งเป็นไฟล์แนบโดยอัตโนมัติผ่าน Outlook ใน Excel

บันทึกแผ่นงานเป็นไฟล์ PDF และส่งเป็นไฟล์แนบพร้อมรหัส VBA


บันทึกแผ่นงานเป็นไฟล์ PDF และส่งเป็นไฟล์แนบพร้อมรหัส VBA

คุณสามารถเรียกใช้รหัส VBA ด้านล่างเพื่อบันทึกแผ่นงานที่ใช้งานอยู่เป็นไฟล์ PDF โดยอัตโนมัติจากนั้นส่งเป็นไฟล์แนบทาง Outlook กรุณาดำเนินการดังนี้

1. เปิดแผ่นงานที่คุณจะบันทึกเป็น PDF แล้วส่งจากนั้นกดปุ่ม อื่น ๆ + F11 พร้อมกันเพื่อเปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างคลิก สิ่งที่ใส่เข้าไป > โมดูล. จากนั้นคัดลอกและวางโค้ด VBA ด้านล่างลงในไฟล์ รหัส หน้าต่าง. ดูภาพหน้าจอ:

รหัส VBA: บันทึกแผ่นงานเป็นไฟล์ PDF และส่งเป็นไฟล์แนบทางอีเมล

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 กด F5 กุญแจสำคัญในการเรียกใช้รหัส ใน หมวดหมู่สินค้า โปรดเลือกโฟลเดอร์ที่จะบันทึกไฟล์ PDF นี้จากนั้นคลิกที่ไฟล์ OK ปุ่ม

หมายเหตุ:

1. ตอนนี้แผ่นงานที่ใช้งานอยู่จะถูกบันทึกเป็นไฟล์ PDF และไฟล์ PDF ถูกตั้งชื่อด้วยชื่อเวิร์กชีต
2. หากแผ่นงานที่ใช้งานว่างอยู่คุณจะได้กล่องโต้ตอบดังภาพด้านล่างที่แสดงหลังจากคลิกที่ไฟล์ OK ปุ่ม

4. ตอนนี้อีเมล Outlook ใหม่ถูกสร้างขึ้นและคุณสามารถเห็นไฟล์ PDF ที่แสดงเป็นไฟล์แนบในไฟล์แนบ ดูภาพหน้าจอ:

5. โปรดเขียนอีเมลนี้แล้วส่ง
6. รหัสนี้จะใช้ได้เฉพาะเมื่อคุณใช้ Outlook เป็นโปรแกรมเมลของคุณ

บันทึกแผ่นงานหรือแผ่นงานหลายแผ่นเป็นไฟล์ PDF แยกกันพร้อมกันได้อย่างง่ายดาย:

พื้นที่ แยกสมุดงาน ประโยชน์ของ Kutools สำหรับ Excel สามารถช่วยให้คุณบันทึกแผ่นงานหรือแผ่นงานหลายแผ่นเป็นไฟล์ PDF แยกกันได้พร้อมกันตามตัวอย่างด้านล่างที่แสดง ดาวน์โหลดและทดลองใช้ทันที! (30เส้นทางฟรีวัน)


บทความที่เกี่ยวข้อง:


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel แก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office/Excel 2007-2021 และ 365 รองรับทุกภาษา ง่ายต่อการปรับใช้ในองค์กรหรือองค์กรของคุณ คุณสมบัติเต็มรูปแบบ ทดลองใช้ฟรี 30 วัน รับประกันคืนเงินภายใน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (63)
ได้รับคะแนน 5 จาก 5 · การจัดอันดับ 1
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
วิธีนี้ใช้ได้ผลดีสำหรับฉัน แต่มีวิธีเลือกตำแหน่งโฟลเดอร์โดยอัตโนมัติแทนที่จะเลือกด้วยตนเองหรือไม่ ฉันหวังว่าจะทำได้ 40 แผ่นพร้อมกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ยังหวังว่าจะเห็นคำตอบสำหรับปัญหานี้! ขอบคุณสำหรับความช่วยเหลือ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันได้ลองวางสิ่งนี้ลงในโมดูลใหม่และฉันได้รับข้อผิดพลาดในการรวบรวม: ไม่ได้กำหนด Sub หรือ Function กรุณาช่วย.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียน คุณดาร์เรน
คุณใช้ Office เวอร์ชันใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สำนักงาน 360
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ปัญหาเดียวกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะแก้ไขสคริปต์ VBA ด้านบนอย่างไรเพื่อเพิ่มการประทับวันที่และเวลาให้กับชื่อไฟล์เพื่อไม่ให้เขียนทับสิ่งที่บันทึกไว้แล้ว
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไมเคิลที่รัก
โปรดเรียกใช้โค้ด VBA ด้านล่างเพื่อแก้ปัญหา

บันทึกย่อย.pdfandsend()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xStr เป็นสตริง

ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xStr = รูปแบบ (ตอนนี้ (), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

มันยอดเยี่ยมมากและทำงานได้อย่างสมบูรณ์แบบสำหรับฉัน ต้องการความช่วยเหลือเพิ่มเติมเพื่อเพิ่ม:

1. ใน "ถึง" ฉันต้องการให้ลิงก์ไปยังเซลล์เฉพาะของแผ่นงานที่ใช้งานอยู่อย่างชาญฉลาดใน CC และใน BCC ฉันต้องการเพิ่มลิงก์แผ่นงานที่ใช้งานอยู่
2. ในเนื้อหาอีเมล ฉันต้องระบุข้อความมาตรฐาน

ฉันจะช่วยเหลือคุณอย่างเต็มที่

ขอบคุณ
Parag
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีครับ คุณ Parag Somani
รหัส VBA ด้านล่างสามารถช่วยคุณได้ โปรดเปลี่ยนฟิลด์ .To, .CC, .BCC และ .Body ตามความต้องการของคุณ

บันทึกย่อย.pdfandsend()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xStr เป็นสตริง

ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xStr = รูปแบบ (ตอนนี้ (), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ช่วง ("A8")
.CC = ช่วง ("A9")
.BCC = ช่วง ("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "เรียน" _
& vbNewLine & vbNewLine & _
"นี่คืออีเมลทดสอบ" & _
"ส่งใน Excel"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันพยายามใช้ช่วงสำหรับ "ถึง", "CC" แต่ไม่ได้รับค่าจากเซลล์ที่กำหนด คุณช่วยเรื่องนี้ได้ไหม?
ขอบคุณ,
Mehul
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

มันยอดเยี่ยมมากและทำงานได้อย่างสมบูรณ์แบบสำหรับฉัน ต้องการความช่วยเหลือเพิ่มเติมเพื่อเพิ่ม:

1. ใน "ถึง" ฉันต้องการให้ลิงก์ไปยังเซลล์เฉพาะของแผ่นงานที่ใช้งานอยู่อย่างชาญฉลาดใน CC และใน BCC ฉันต้องการเพิ่มลิงก์แผ่นงานที่ใช้งานอยู่
2. ในเนื้อหาอีเมล ฉันต้องระบุข้อความมาตรฐาน

ฉันจะช่วยเหลือคุณอย่างเต็มที่

ขอบคุณ
Parag
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

มันยอดเยี่ยมมากและทำงานได้อย่างสมบูรณ์แบบสำหรับฉัน ต้องการความช่วยเหลือเพิ่มเติมเพื่อเพิ่ม:

1. ใน "ถึง" ฉันต้องการให้ลิงก์ไปยังเซลล์เฉพาะของแผ่นงานที่ใช้งานอยู่อย่างชาญฉลาดใน CC และใน BCC ฉันต้องการเพิ่มลิงก์แผ่นงานที่ใช้งานอยู่
2. ในเนื้อหาอีเมล ฉันต้องระบุข้อความมาตรฐาน

ฉันจะช่วยเหลือคุณอย่างเต็มที่

ขอบคุณ
Parag
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะเพิ่มตัวอย่างแผ่นงาน 2 จากสมุดงานเป็น pdf ได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีอาร์มิน
คุณต้องเปิดชีต 2 ในเวิร์กบุ๊กของคุณก่อน แล้วจึงเรียกใช้โค้ด VBA พร้อมขั้นตอนข้างต้นเพื่อลง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะแก้ไขสคริปต์ VBA ด้านบนเพื่อให้ชื่อไฟล์ถูกบันทึกเป็นเซลล์เฉพาะที่เลือกภายในชีตปัจจุบัน เช่น เซลล์ A1 ได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีทอม.
ขอโทษที่ช่วยเรื่องนี้ไม่ได้
ยินดีต้อนรับสู่การโพสต์คำถามใด ๆ ในฟอรัมของเรา: https://www.extendoffice.com/forum.html
คุณจะได้รับการสนับสนุน Excel เพิ่มเติมจากผู้ใช้ Excel มืออาชีพหรือผู้ชื่นชอบ Excel คนอื่นๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันจะบันทึกและส่ง pdf ด้วยชื่อเวิร์กบุคด้วยรหัส VBA ปัจจุบันได้อย่างไร ฉันจะใช้อะไรแทน xSht.Name
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เจมส์ hi,
คุณต้องการส่งแผ่นงานที่ใช้งานอยู่เป็น pdf และตั้งชื่อเป็นชื่อสมุดงานหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมันใช้งานได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะทำให้ลบ pdf ที่บันทึกไว้หลังจากส่งอีเมลได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีเจสัน
ขอโทษที่ยังช่วยคุณไม่ได้ คุณต้องลบด้วยตนเองหลังจากส่งอีเมล
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี,

เป็นไปได้ไหมที่จะค้นหาชื่อสำหรับ pdf จากเซลล์? อดีต. เซลล์ H4


และในเซลล์ H4 ฉันต้องการให้มันรวบรวมจากสามเซลล์ที่แตกต่างกัน เป็นไปได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นี้เป็นไปได้ สร้างตัวแปรแยกกันเพื่อเก็บค่าจากเซลล์ แล้วใช้ตัวแปรเหล่านั้นเมื่อตั้งค่า xFolder
ฉันใช้ค่าจากเซลล์ในชีตบวกกับวันที่ของวันนี้ คุณสามารถทำค่าหลายเซลล์ได้อย่างง่ายดาย

นี่คือสิ่งที่ฉันเพิ่ม:
Dim xMemberName เป็นสตริง
Dim xFileDate เป็นสตริง

xMemberName = ช่วง ("H3") .Value
xFileDate = รูปแบบ (ตอนนี้ "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันได้รับข้อผิดพลาดเมื่อฉันลองสิ่งนี้ ฉันควรวางสิ่งนี้ไว้ที่ใดในรหัส
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล



มันยอดเยี่ยมมากและทำงานได้อย่างสมบูรณ์แบบสำหรับฉัน ต้องการความช่วยเหลือเพิ่มเติมเพื่อเพิ่ม:

1. ใน "เนื้อหา" ฉันต้องการให้ลิงก์ไปยังเซลล์เฉพาะของแผ่นงานที่ใช้งานอยู่ เพิ่มเติม ต้องการทำให้ข้อความเป็นตัวหนา

ขอบคุณ

ความนับถือ

Kishore kumar
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี

คุณหมายถึงการเพิ่มค่าของเซลล์โดยอัตโนมัติไปยังเนื้อหาเมลและเป็นตัวหนาหรือไม่ สมมติว่าคุณเพิ่มค่าของ C4 ให้กับเนื้อหาเมล กรุณาใช้รหัสด้านล่าง

บันทึกย่อย.pdfandsend()

Dim xSht เป็นแผ่นงาน

Dim xFileDlg เป็น FileDialog

Dim xFolder เป็นสตริง

Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม

Dim xOutlookObj เป็นวัตถุ

Dim xEmailObj เป็นวัตถุ

Dim xUsedRng เป็นช่วง



ตั้งค่า xSht = ActiveSheet

ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)



ถ้า xFileDlg.Show = True แล้ว

xFolder = xFileDlg.SelectedItems(1)

อื่น

MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"

ออกจาก Sub

End If

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



'ตรวจสอบว่าไฟล์มีอยู่แล้ว

ถ้า Len(Dir(xFolder)) > 0 แล้ว

xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _

vbYesNo + vbQuestion "ไฟล์มีอยู่")

เกี่ยวกับข้อผิดพลาดต่อไป

ถ้า xYesorNo = vbYes แล้ว

ฆ่า xFolder

อื่น

MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _

& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"

ออกจาก Sub

End If

ถ้า Err.Number <> 0 แล้ว

MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _

& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"

ออกจาก Sub

End If

End If



ตั้งค่า xUsedRng = xSht.UsedRange

ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว

'บันทึกเป็นไฟล์ PDF

xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard



'สร้างอีเมล Outlook

ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")

ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)

ด้วย xEmailObj

.แสดง

.To = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Add xFolder

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

ถ้า DisplayEmail = False แล้ว

'.ส่ง

End If

จบด้วย

อื่น

MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"

ออกจาก Sub

End If

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ถ้าฉันต้องการให้บันทึกอัตโนมัติในโฟลเดอร์เฉพาะทุกครั้ง (ทำให้ผู้ใช้ไม่ต้องเลือกโฟลเดอร์) ฉันจะทำอย่างไร
อดีต. C: ใบแจ้งหนี้/อเมริกาเหนือ/ลูกค้า
ความช่วยเหลือได้รับการชื่นชมอย่างมาก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี เจฟฟ์
คุณหมายถึงบันทึกเวิร์กชีตเป็นไฟล์ pdf และบันทึกลงในโฟลเดอร์เฉพาะโดยไม่ส่งใช่หรือไม่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันคิดว่าเจฟฟ์หมายถึงความสามารถในการระบุโฟลเดอร์เฉพาะในโค้ดที่ไฟล์ pdf ถูกบันทึกในแต่ละครั้ง แทนที่จะต้องเลือกตำแหน่งด้วยตนเอง pdf จะถูกส่งทางอีเมลจากโฟลเดอร์เฉพาะนั้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณเจเรมี
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Geoff หากคุณต้องการบันทึกไฟล์ pdf โดยอัตโนมัติไปยังโฟลเดอร์เฉพาะแทนที่จะเลือกตำแหน่งด้วยตนเอง โปรดลองใช้โค้ดด้านล่าง อย่าลืมเปลี่ยนเส้นทางโฟลเดอร์ในรหัส
บันทึกย่อยAsPDFandSend()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xPath เป็นสตริง
ตั้งค่า xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\แผ่นงานเป็น pdf" 'ที่นี่ "เวิร์กชีตเป็น pdf" เป็นโฟลเดอร์ปลายทางสำหรับบันทึกไฟล์ pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสนี้ใช้งานได้ดียกเว้นฉันต้องการบันทึกเวิร์กชีตเป็นชื่อชีต + วันที่ (เช่น Sheet1 1 ต.ค. 2020); บนเดสก์ท็อปของผู้ใช้ (หลายคนจะใช้สิ่งนี้และเส้นทางอาจแตกต่างกันเล็กน้อย) ถ้าเป็นไปได้ ฉันต้องการฝัง .jpg ลงในเนื้อหาด้วย.. JPG จะอยู่ทั้งภายในเวิร์กชีต (นอกพื้นที่พิมพ์) และรูปภาพจะถูกเก็บไว้บนเซิร์ฟเวอร์ที่ใช้ร่วมกัน.. แม้ว่าเส้นทางไปยังเซิร์ฟเวอร์จะแตกต่างกันไปตาม ผู้ใช้ (ส่วนใหญ่เป็นไดรฟ์ "T" สำหรับไดรฟ์ "U")
สามารถทำได้หรือไม่ กรุณาและขอบคุณล้านครั้ง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์

สวัสดี มันใช้งานได้ดีมาก ขอบคุณสำหรับการแบ่งปัน เพียงแค่ต้องการความช่วยเหลือ
ถ้าฉันต้องการบันทึกไฟล์ PDF ด้วยชื่อที่กำหนดเอง (ตัวเลือกในการพิมพ์ชื่อไฟล์ในกล่องโต้ตอบ SaveAs) เนื่องจากผู้ใช้ใช้ตัวเลือกนี้ในเทมเพลตฟอร์มที่บันทึกแบบฟอร์มเป็น PDF ด้วยชื่อเฉพาะ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี โปรดลองใช้รหัส VBA ด้านล่าง หลังจากรันโค้ดแล้ว ให้เลือกโฟลเดอร์ที่จะบันทึกไฟล์ PDF จากนั้นกล่องโต้ตอบจะปรากฏขึ้นเพื่อให้คุณป้อนชื่อไฟล์ บันทึกย่อย.pdfandsend()
'ปรับปรุงโดย Extendoffice 20210209
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xStrName เป็นสตริง
Dim xV เป็นตัวแปร

ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xStrName = ""
xV = Application.InputBox("โปรดป้อนชื่อไฟล์:", "Kutools สำหรับ Excel", , , , , , 2)
ถ้า xV = เท็จ แล้ว
ออกจาก Sub
End If
xStrName = xV
ถ้า xStrName = "" แล้ว
MsgBox ("ไม่ได้ป้อนชื่อไฟล์ กำลังออกจากกระบวนการ!")
ออกจาก Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
หากฉันมีไฟล์สองแผ่นในไฟล์ และฉันต้องการเรียกใช้มาโครนี้ในแผ่นงานเดียว (โดยการกดปุ่ม) แต่ส่งอีกแผ่นหนึ่ง ฉันจะรับมาโครนี้ได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการบันทึกสิ่งนี้ไว้ในตำแหน่งไฟล์หนึ่ง โดยใช้ชื่อตามค่าในเซลล์ C30 ฉันได้ลองใช้ตัวเลือกสองสามตัวแล้ว แต่ก็ยังมีข้อผิดพลาดอยู่เรื่อยๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี hein รหัสด้านล่างอาจช่วยได้ หลังจากรันโค้ดแล้ว ให้เลือกโฟลเดอร์ที่ต้องการบันทึกไฟล์ PDF จากนั้นกล่องโต้ตอบจะปรากฏขึ้นเพื่อให้คุณป้อนชื่อไฟล์ บันทึกย่อย.pdfandsend()
'ปรับปรุงโดย Extendoffice 20210209
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xStrName เป็นสตริง
Dim xV เป็นตัวแปร

ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xStrName = ""
xV = Application.InputBox("โปรดป้อนชื่อไฟล์:", "Kutools สำหรับ Excel", , , , , , 2)
ถ้า xV = เท็จ แล้ว
ออกจาก Sub
End If
xStrName = xV
ถ้า xStrName = "" แล้ว
MsgBox ("ไม่ได้ป้อนชื่อไฟล์ กำลังออกจากกระบวนการ!")
ออกจาก Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณสำหรับสิ่งนั้น เยี่ยมมาก แต่ฉันต้องการให้ตั้งชื่อชีตตามเซลล์ A1 บนชีต 1 สถานที่ที่จะบันทึกตาม A1 บนชีต 2 เช่น C:\Users\peete\Dropbox\Screenshots และส่งอีเมลไปที่ ที่อยู่อีเมลบนกระดาษ A3 2 สิ่งที่ฉันได้ทำไปแล้ว
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณสำหรับสิ่งนั้น เยี่ยมมาก แต่ฉันต้องการให้ตั้งชื่อชีตตามเซลล์ A1 บนชีต 1 สถานที่ที่จะบันทึกตาม A1 บนชีต 2 เช่น C:\Users\peete\Dropbox\Screenshots แต่สามารถเปลี่ยนได้เมื่อ โดยใช้ไฟล์และอีเมลส่งไปยังที่อยู่อีเมลบนกระดาษ A3 2 สิ่งที่ฉันได้ทำไปแล้ว
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hi คริสตัล ขอบคุณมากสำหรับการแบ่งปัน มีวิธีเลือกแผ่นงานหลายแผ่น (จากสมุดงานเดียวกัน) เพื่อบันทึกแต่ละแผ่นเป็น PDF อิสระแล้วส่งเอกสารแนบทั้งหมดมาในอีเมลฉบับเดียวหรือไม่
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัส VBA ด้านล่างสามารถช่วยคุณได้ โปรดลองใช้ในบรรทัดที่สิบสองของรหัส โปรดแทนที่ชื่อแผ่นงานด้วยชื่อแผ่นงานจริงในกรณีของคุณ
บันทึกย่อย.pdfandsend1()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ ฉัน xNum As Integer
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xArrShetts เป็น Variant
Dim xPDFNameAddress เป็นสตริง
Dim xStr เป็นสตริง
xArrShetts = อาร์เรย์ ("ทดสอบ", "แผ่นที่ 1", "แผ่นที่ 2") 'ป้อนชื่อชีตที่คุณจะส่งเป็นไฟล์ pdf ที่ใส่เครื่องหมายคำพูดและคั่นด้วยเครื่องหมายจุลภาค ตรวจสอบให้แน่ใจว่าไม่มีอักขระพิเศษ เช่น \/:"*<>| ในชื่อไฟล์

สำหรับฉัน = 0 ถึง UBound(xArrShetts)
เกี่ยวกับข้อผิดพลาดต่อไป
ตั้งค่า xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
ถ้า xSht.Name <> xArrShetts(I) แล้ว
MsgBox "ไม่พบแผ่นงาน ออกจากการทำงาน:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
ออกจาก Sub
End If
ต่อไป


ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
'ตรวจสอบว่าไฟล์มีอยู่แล้ว
xYesorNo = MsgBox("หากมีไฟล์ชื่อเดียวกันอยู่ในโฟลเดอร์ปลายทาง หมายเลขต่อท้ายจะถูกเพิ่มไปยังชื่อไฟล์โดยอัตโนมัติเพื่อแยกแยะความแตกต่างของไฟล์ที่ซ้ำกัน" & vbCrLf & vbCrLf & "คลิกใช่เพื่อดำเนินการต่อ คลิก No เพื่อยกเลิก", ​​_
vbYesNo + vbQuestion "ไฟล์มีอยู่")
ถ้า xYesorNo <> vbYes จากนั้นออกจาก Sub
สำหรับฉัน = 0 ถึง UBound(xArrShetts)
ตั้งค่า xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
ในขณะที่ไม่ (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xStr คุณภาพ:=xlQualityStandard
อื่น

End If
xArrShetts(I) = xStr
ต่อไป

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = "????"
สำหรับฉัน = 0 ถึง UBound(xArrShetts)
.Attachments เพิ่ม xArrShetts(I)
ต่อไป
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี การเปลี่ยนแปลงอย่างหนึ่งที่ฉันกำลังประสบอยู่คือการสร้างอีเมลแยกต่างหากสำหรับเอกสาร PDF แต่ละฉบับที่สร้างขึ้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ในการสร้างอีเมลแยกต่างหากสำหรับเอกสาร pdf แต่ละฉบับ คุณสามารถเรียกใช้ VBA ที่ให้ไว้ในโพสต์ในเวิร์กชีตต่างๆ ด้วยตนเองเพื่อดำเนินการให้เสร็จสิ้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีแผ่นงานมากกว่า 100 แผ่นในสมุดงาน ซึ่งจะทำให้ฉันต้องเรียกใช้ VBA มากกว่า 100 ครั้ง ซึ่งใช้เวลานาน  
ฉันจัดการแบ่งสมุดงานออกเป็นหลายแผ่นได้ จากนั้นฉันก็สามารถแปลงแผ่นงานแต่ละแผ่นเป็นเอกสาร PDF แต่ละรายการได้
วิธีแก้ปัญหาที่ฉันกำลังมองหาคือส่งอีเมลเอกสาร PDF แต่ละฉบับแยกกันในขณะที่กระบวนการข้างต้นกำลังทำงานอยู่
ด้วย VBA ที่ฉันกำลังใช้งานอยู่:
บันทึกย่อย.pdfandsend1()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ ฉัน xNum As Integer
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xArrShetts เป็น Variant
Dim xPDFNameAddress เป็นสตริง
Dim xStr เป็นสตริง
xArrShetts = Array("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 ที่ใส่เครื่องหมายคำพูดและคั่นด้วยเครื่องหมายจุลภาค ตรวจสอบให้แน่ใจว่าไม่มีอักขระพิเศษ เช่น \/:"*<>| ในชื่อไฟล์

สำหรับฉัน = 0 ถึง UBound(xArrShetts)
เกี่ยวกับข้อผิดพลาดต่อไป
ตั้งค่า xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
ถ้า xSht.Name <> xArrShetts(I) แล้ว
MsgBox "ไม่พบแผ่นงาน ออกจากการทำงาน:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
ออกจาก Sub
End If
ต่อไป


ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
'ตรวจสอบว่าไฟล์มีอยู่แล้ว
xYesorNo = MsgBox("หากมีไฟล์ชื่อเดียวกันอยู่ในโฟลเดอร์ปลายทาง หมายเลขต่อท้ายจะถูกเพิ่มไปยังชื่อไฟล์โดยอัตโนมัติเพื่อแยกแยะความแตกต่างของไฟล์ที่ซ้ำกัน" & vbCrLf & vbCrLf & "คลิกใช่เพื่อดำเนินการต่อ คลิก No เพื่อยกเลิก", ​​_
vbYesNo + vbQuestion "ไฟล์มีอยู่")
ถ้า xYesorNo <> vbYes จากนั้นออกจาก Sub
สำหรับฉัน = 0 ถึง UBound(xArrShetts)
ตั้งค่า xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
ในขณะที่ไม่ (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xStr คุณภาพ:=xlQualityStandard
อื่น

End If
xArrShetts(I) = xStr
ต่อไป

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "????"
สำหรับฉัน = 0 ถึง UBound(xArrShetts)
เกี่ยวกับข้อผิดพลาดต่อไป
.Attachments เพิ่ม xArrShetts(I)
ต่อไป
ถ้า DisplayEmail = False แล้ว
.ส่ง
ออกจาก Sub
End If
จบด้วย


ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี @crystal
นี่มันเยี่ยมมาก สิ่งสำคัญ o ที่ฉันกำลังดิ้นรนคือชื่อไฟล์ - ฉันต้องการให้ชื่อไฟล์ดึงจากเซลล์ในเวิร์กชีตแทนที่จะใช้ชื่อแท็บ ฉันได้แก้ไขรหัสเพื่อบันทึกโดยอัตโนมัติไปยังโฟลเดอร์ที่ระบุแล้ว แต่กำลังประสบปัญหากับชื่อไฟล์
ความช่วยเหลือใด ๆ ที่คุณสามารถเสนอได้โปรด?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Tori ถ้าคุณต้องการตั้งชื่อไฟล์ PDF ด้วยค่าเซลล์เฉพาะ โปรดลองใช้รหัสต่อไปนี้ หลังจากเรียกใช้รหัสและเลือกโฟลเดอร์ที่จะบันทึกไฟล์ กล่องโต้ตอบอื่นจะปรากฏขึ้น โปรดเลือกเซลล์ที่คุณจะใช้ ค่าเป็นชื่อของไฟล์ PDF จากนั้นคลิก ตกลง เพื่อเสร็จสิ้น
บันทึกย่อย.pdfandsend2()
'ปรับปรุงโดย Extendoffice 20210521
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng, xRgInser เป็นช่วง
Dim xB เป็นบูลีน
ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xB = จริง
เกี่ยวกับข้อผิดพลาดต่อไป
ในขณะที่ xB
ตั้งค่า xRgInser = Nothing
Set xRgInser = Application.InputBox("เลือกเซลล์ที่คุณจะใช้ค่าเพื่อตั้งชื่อไฟล์ PDF:", "Kutools for Excel", , , , , , , 8)
ถ้า xRgInser ไม่มีอะไรเลย
MsgBox " ไม่ได้เลือกเซลล์ ออกจากการดำเนินการ!", vbInformation, "Kutools for Excel"
ออกจาก Sub
End If
ถ้า xRgInser.Text = "" แล้ว
MsgBox " เซลล์ที่เลือกว่างเปล่า โปรดเลือกใหม่!", vbInformation, "Kutools for Excel"
อื่น
xB = เท็จ
End If
Wend

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

'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการสิ่งที่คล้ายกัน ดังนั้นนี่คือสิ่งที่ฉันได้รับ มันใช้วันที่ปัจจุบันและสร้างโฟลเดอร์ใหม่ที่มีชื่อวันที่ในตำแหน่งเฉพาะ โดยจะวาง pdf ไว้ในตำแหน่งใหม่นั้น จากนั้นแนบ pdf ลงในอีเมลใหม่ ทำงานเป็นการรักษา ฉันเพิ่งเริ่มต้นดังนั้นโปรดอภัยหากมันดูเลอะเทอะ :D
ไฟล์ PDF ย่อยTOEMAIL()
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xPath เป็นสตริง
Dim xOutMsg เป็นสตริง
Dim sFolderName เป็นสตริง, sFolder เป็นสตริง
Dim sFolderPath เป็นสตริง

ตั้งค่า xSht = ActiveSheet
xFileDate = รูปแบบ (ตอนนี้ "dd-mm-yyyy")
sFolder = "C:" 'นี่คือที่ที่คุณมีโฟลเดอร์หลัก
sFolderName = "Week ending " + Format(Now, "dd-mm-yyyy") 'โฟลเดอร์ที่จะถูกสร้างขึ้นในโฟลเดอร์หลักที่มีชื่อ Week ending และวันที่ปัจจุบัน
sFolderPath = "C:" & sFolderName 'โฟลเดอร์หลักอีกครั้งเพื่อสร้างเส้นทางใหม่รวมถึงโฟลเดอร์ใหม่
ชุด oFSO = CreateObject("Scripting.FileSystemObject")
ถ้า oFSO.FolderExists(sFolderPath) แล้ว
MsgBox "มีโฟลเดอร์นี้อยู่แล้ว !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "ข้อมูล"
อื่น
MkDir sFolderPath
MsgBox "สร้างโฟลเดอร์ใหม่แล้ว !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "ข้อมูล"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " โปรดดูไฟล์แนบ อีเมลและไฟล์แนบนี้ถูกสร้างขึ้นโดยอัตโนมัติ "
'เพิ่มข้อความว่าอีเมลถูกสร้างขึ้นโดยอัตโนมัติ

ด้วย xEmailObj
.แสดง
.To = "" 'เพิ่มอีเมลของคุณเอง
.CC = ""
.Subject = xSht.Name + " PDF for week end " + xFileDate + " - Location " ' subject ประกอบด้วยชื่อแผ่นงาน pdf วันที่และตำแหน่ง ซึ่งสามารถแก้ไขได้ตามต้องการ
.Attachments.Add xFolder
.HTMLBody = xOutMsg & .HTMLBody
ถ้า DisplayEmail = False แล้ว
'ส่ง <--- ที่นี่ ถ้าคุณลบเครื่องหมายอะพอสทรอฟี อีเมลจะถูกส่งโดยอัตโนมัติ ดังนั้นโปรดระวัง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะแก้ไขโค้ดนี้เพื่อบันทึกเฉพาะเซลล์ ("a1:r99") เพื่อบันทึกเป็น PDF ได้อย่างไร ฉันมีสิ่งพิเศษด้านข้างที่ฉันไม่ต้องการในเอกสาร PDF ของฉัน
บันทึกย่อย.pdfandsend()
'ปรับปรุงโดย Extendoffice 20210209
Dim xSht เป็นแผ่นงาน
Dim xFileDlg เป็น FileDialog
Dim xFolder เป็นสตริง
Dim xใช่หรือไม่ใช่ เป็นจำนวนเต็ม
Dim xOutlookObj เป็นวัตถุ
Dim xEmailObj เป็นวัตถุ
Dim xUsedRng เป็นช่วง
Dim xStrName เป็นสตริง
Dim xV เป็นตัวแปร

ตั้งค่า xSht = ActiveSheet
ตั้งค่า xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

ถ้า xFileDlg.Show = True แล้ว
xFolder = xFileDlg.SelectedItems(1)
อื่น
MsgBox "คุณต้องระบุโฟลเดอร์ที่จะบันทึก PDF ลงใน" & vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ต้องระบุโฟลเดอร์ปลายทาง"
ออกจาก Sub
End If
xStrName = ""
xV = Application.InputBox("โปรดป้อนชื่อไฟล์:", "Kutools สำหรับ Excel", , , , , , 2)
ถ้า xV = เท็จ แล้ว
ออกจาก Sub
End If
xStrName = xV
ถ้า xStrName = "" แล้ว
MsgBox ("ไม่ได้ป้อนชื่อไฟล์ กำลังออกจากกระบวนการ!")
ออกจาก Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'ตรวจสอบว่าไฟล์มีอยู่แล้ว
ถ้า Len(Dir(xFolder)) > 0 แล้ว
xYesorNo = MsgBox(xFolder & " มีอยู่แล้ว" & vbCrLf & vbCrLf & "คุณต้องการเขียนทับหรือไม่", _
vbYesNo + vbQuestion "ไฟล์มีอยู่")
เกี่ยวกับข้อผิดพลาดต่อไป
ถ้า xYesorNo = vbYes แล้ว
ฆ่า xFolder
อื่น
MsgBox "ถ้าคุณไม่เขียนทับ PDF ที่มีอยู่ ฉันไม่สามารถดำเนินการต่อได้" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "กำลังออกจากมาโคร"
ออกจาก Sub
End If
ถ้า Err.Number <> 0 แล้ว
MsgBox "ไม่สามารถลบไฟล์ที่มีอยู่ โปรดตรวจสอบให้แน่ใจว่าไฟล์นั้นไม่ได้เปิดอยู่หรือป้องกันการเขียน" _
& vbCrLf & vbCrLf & "กดตกลงเพื่อออกจากมาโครนี้", vbCritical, "ไม่สามารถลบไฟล์ได้"
ออกจาก Sub
End If
End If

ตั้งค่า xUsedRng = xSht.UsedRange
ถ้า Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 แล้ว
'บันทึกเป็นไฟล์ PDF
xSht.ExportAsFixedFormat Type:=xlTypePDF ชื่อไฟล์:=xFolder คุณภาพ:=xlQualityStandard

'สร้างอีเมล Outlook
ตั้งค่า xOutlookObj = CreateObject("Outlook.Application")
ตั้งค่า xEmailObj = xOutlookObj.CreateItem(0)
ด้วย xEmailObj
.แสดง
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
ถ้า DisplayEmail = False แล้ว
'.ส่ง
End If
จบด้วย
อื่น
MsgBox "แผ่นงานไม่สามารถเว้นว่างได้"
ออกจาก Sub
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันเพิ่งลองใช้รหัสนี้ในเวิร์กชีตแผ่นใดแผ่นหนึ่งของฉัน และฉันได้ตั้งค่าพื้นที่การพิมพ์ไว้ ดังนั้นสิ่งพิเศษที่อยู่ด้านล่างจึงไม่ปรากฏใน pdf ลองมัน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hi
ขอบคุณมากสำหรับรหัส แต่เป็นไปได้ไหมที่จะบันทึก PDF โดยอัตโนมัติไปยังตำแหน่งเดียวกับไฟล์ Excel ที่ใช้งานอยู่และมีชื่อไฟล์เดียวกับไฟล์ Excel ที่ใช้งานอยู่
ขอบคุณมาก
คัน
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
โหลดเพิ่มเติม
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ

ช่องทางอื่นๆ

ลิขสิทธิ์© 2009 - wwwextendoffice.com | สงวนลิขสิทธิ์. ขับเคลื่อนโดย ExtendOffice. | แผนผังเว็บไซต์
Microsoft และโลโก้ Office เป็นเครื่องหมายการค้าหรือเครื่องหมายการค้าจดทะเบียนของ Microsoft Corporation ในสหรัฐอเมริกาและ / หรือประเทศอื่น ๆ
ได้รับการปกป้องโดย Sectigo SSL