Note: The other languages of the website are Google-translated. Back to English
Đăng nhập Đăng ký

Làm cách nào để lưu trang tính dưới dạng tệp PDF và gửi qua email dưới dạng tệp đính kèm thông qua Outlook?

Trong một số trường hợp, bạn có thể cần gửi trang tính dưới dạng tệp PDF thông qua Outlook. Thông thường, bạn phải lưu trang tính theo cách thủ công dưới dạng tệp PDF, sau đó tạo một email mới với tệp PDF này dưới dạng tệp đính kèm trong Outlook của bạn và cuối cùng là gửi nó. Để đạt được nó theo cách thủ công từng bước rất tốn thời gian. Trong bài viết này, chúng tôi sẽ hướng dẫn bạn cách nhanh chóng lưu trang tính dưới dạng tệp PDF và gửi tự động dưới dạng tệp đính kèm thông qua Outlook trong Excel.

Lưu trang tính dưới dạng tệp PDF và gửi qua email dưới dạng tệp đính kèm với mã VBA

Lưu trang tính dưới dạng tệp PDF và gửi qua email dưới dạng tệp đính kèm với mã VBA

Bạn có thể chạy mã VBA dưới đây để tự động lưu trang tính đang hoạt động dưới dạng tệp PDF, sau đó gửi qua email dưới dạng tệp đính kèm thông qua Outlook. Hãy làm như sau.

1. Mở trang tính bạn sẽ lưu dưới dạng PDF và gửi, sau đó nhấn Khác + F11 các phím đồng thời để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. bên trong Microsoft Visual Basic cho các ứng dụng cửa sổ, nhấp Chèn > Mô-đun. Sau đó sao chép và dán mã VBA bên dưới vào Mã cửa sổ. Xem ảnh chụp màn hình:

Mã VBA: Lưu trang tính dưới dạng tệp PDF và gửi qua email dưới dạng tệp đính kèm

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. Nhấn nút F5 phím để chạy mã. bên trong Xem hộp thoại, vui lòng chọn một thư mục để lưu tệp PDF này, sau đó nhấp vào OK .

Chú ý:

1. Bây giờ trang tính đang hoạt động được lưu dưới dạng tệp PDF. Và tệp PDF được đặt tên với tên trang tính.
2. Nếu trang tính đang hoạt động trống, bạn sẽ nhận được một hộp thoại như ảnh chụp màn hình bên dưới được hiển thị sau khi nhấp vào OK .

4. Bây giờ một email Outlook mới đã được tạo và bạn có thể thấy tệp PDF được liệt kê dưới dạng tệp đính kèm trong Đã đính kèm. Xem ảnh chụp màn hình:

5. Vui lòng soạn email này và sau đó gửi nó.
6. Mã này chỉ có sẵn khi bạn sử dụng Outlook làm chương trình thư của mình.

Dễ dàng lưu một trang tính hoặc nhiều trang tính dưới dạng các tệp PDF riêng biệt cùng một lúc:

Mô hình Chia sổ làm việc tiện ích của Kutools cho Excel có thể giúp bạn dễ dàng lưu một trang tính hoặc nhiều trang tính dưới dạng các tệp PDF riêng biệt cùng một lúc như minh họa bên dưới. Tải xuống và thử ngay bây giờ! (30-ngày đường mòn miễn phí)

Các bài liên quan:

Các công cụ năng suất văn phòng tốt nhất

Kutools cho Excel giải quyết hầu hết các vấn đề của bạn và tăng 80% năng suất của bạn

  • Tái sử dụng: Chèn nhanh công thức phức tạp, biểu đồ và bất cứ thứ gì bạn đã sử dụng trước đây; Mã hóa ô với mật khẩu; Tạo danh sách gửi thư và gửi email ...
  • Thanh siêu công thức (dễ dàng chỉnh sửa nhiều dòng văn bản và công thức); Bố cục đọc (dễ dàng đọc và chỉnh sửa số lượng ô lớn); Dán vào Dải ô đã Lọchữu ích. Cảm ơn !
  • Hợp nhất các ô / hàng / cột mà không làm mất dữ liệu; Nội dung phân chia ô; Kết hợp các hàng / cột trùng lặp... Ngăn chặn các ô trùng lặp; So sánh các dãyhữu ích. Cảm ơn !
  • Chọn trùng lặp hoặc duy nhất Hàng; Chọn hàng trống (tất cả các ô đều trống); Tìm siêu và Tìm mờ trong Nhiều Sổ làm việc; Chọn ngẫu nhiên ...
  • Bản sao chính xác Nhiều ô mà không thay đổi tham chiếu công thức; Tự động tạo tài liệu tham khảo sang Nhiều Trang tính; Chèn Bullets, Hộp kiểm và hơn thế nữa ...
  • Trích xuất văn bản, Thêm Văn bản, Xóa theo Vị trí, Xóa không gian; Tạo và In Tổng số phân trang; Chuyển đổi giữa nội dung ô và nhận xéthữu ích. Cảm ơn !
  • Siêu lọc (lưu và áp dụng các lược đồ lọc cho các trang tính khác); Sắp xếp nâng cao theo tháng / tuần / ngày, tần suất và hơn thế nữa; Bộ lọc đặc biệt bằng cách in đậm, in nghiêng ...
  • Kết hợp Workbook và WorkSheets; Hợp nhất các bảng dựa trên các cột chính; Chia dữ liệu thành nhiều trang tính; Chuyển đổi hàng loạt xls, xlsx và PDFhữu ích. Cảm ơn !
  • Hơn 300 tính năng mạnh mẽ. Hỗ trợ Office / Excel 2007-2021 và 365. Hỗ trợ tất cả các ngôn ngữ. Dễ dàng triển khai trong doanh nghiệp hoặc tổ chức của bạn. Đầy đủ tính năng Dùng thử miễn phí 30 ngày. Bảo đảm hoàn lại tiền trong 60 ngày.
tab kte 201905

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
officetab dưới cùng
Nhận xét (63)
Xếp hạng 5 trong 5 · xếp hạng 1
Michael
Michael
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Điều này rất hiệu quả đối với tôi nhưng có cách nào để chọn vị trí thư mục tự động thay vì chọn thủ công không? Tôi hy vọng làm được điều này cho 40 tờ cùng một lúc.
đáp lại
0
0
Hugh
Hugh     Michael
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cũng hy vọng để xem một câu trả lời cho vấn đề này! Cảm ơn đã giúp đỡ!
đáp lại
0
0
Darren
Darren
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đã thử dán cái này vào một mô-đun mới và tôi gặp lỗi Biên dịch: Phụ hoặc Chức năng không được xác định. Hãy giúp tôi.
đáp lại
0
0
pha lê
pha lê     Darren
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Darren thân mến,
Bạn sử dụng phiên bản Office nào?
đáp lại
Report
0
0
Nakia
Nakia     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Văn phòng 360
đáp lại
0
0
Hóa đơn
Hóa đơn     Darren
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cùng một vấn đề
đáp lại
0
0
Micheal Charlie
Micheal Charlie
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào để chỉnh sửa tập lệnh VBA ở trên để nó thêm dấu ngày và giờ vào tên tệp theo cách đó nó không tiếp tục ghi đè lên những gì đã được lưu?
đáp lại
Report
0
0
pha lê
pha lê     Micheal Charlie
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Michael thân mến,
Vui lòng chạy mã VBA dưới đây để giải quyết vấn đề.

Sub Saveaspdfandsend ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Làm mờ xStr dưới dạng chuỗi

Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xStr = Định dạng (Now (), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Parag Somani
Parag Somani     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Crystal,

Nó thực sự tuyệt vời và hoạt động hoàn hảo đối với tôi. Cần thêm trợ giúp để thêm:

1. trong "Tới", tôi muốn cung cấp liên kết đến ô cụ thể của trang tính Hoạt động như khôn ngoan trong CC và trong BCC, tôi muốn thêm liên kết trang tính hoạt động
2. trong nội dung e-mail, tôi cần chỉ định một số văn bản tiêu chuẩn.

Tôi sẽ rất vui vì sự giúp đỡ của bạn.

Cảm ơn
Dù lượn
đáp lại
0
0
pha lê
pha lê     Parag Somani
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Parag Somani,
Mã VBA dưới đây có thể giúp bạn. Vui lòng thay đổi các trường .To, .CC, .BCC và .Body dựa trên nhu cầu của bạn.

Sub Saveaspdfandsend ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Làm mờ xStr dưới dạng chuỗi

Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xStr = Định dạng (Now (), "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = Phạm vi ("A8")
.CC = Phạm vi ("A9")
.BCC = Phạm vi ("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Body = "Kính gửi" _
& vbNewLine & vbNewLine & _
"Đây là email thử nghiệm" & _
"gửi trong Excel"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Mehul
Mehul     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đã cố gắng sử dụng Phạm vi cho "Tới", "CC", nó chỉ không nhận các giá trị từ ô được chỉ định. Bạn có thể vui lòng giúp đỡ về điều này?
Cảm ơn,
Mehul
đáp lại
0
0
Parag Somani
Parag Somani     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Crystal,

Nó thực sự tuyệt vời và hoạt động hoàn hảo đối với tôi. Cần thêm trợ giúp để thêm:

1. trong "Tới", tôi muốn cung cấp liên kết đến ô cụ thể của trang tính Hoạt động như khôn ngoan trong CC và trong BCC, tôi muốn thêm liên kết trang tính hoạt động
2. trong nội dung e-mail, tôi cần chỉ định một số văn bản tiêu chuẩn.

Tôi sẽ rất vui vì sự giúp đỡ của bạn.

Cảm ơn
Dù lượn
đáp lại
0
0
Dù lượn
Dù lượn     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Crystal,

Nó thực sự tuyệt vời và hoạt động hoàn hảo đối với tôi. Cần thêm trợ giúp để thêm:

1. trong "Tới", tôi muốn cung cấp liên kết đến ô cụ thể của trang tính Hoạt động như khôn ngoan trong CC và trong BCC, tôi muốn thêm liên kết trang tính hoạt động
2. trong nội dung e-mail, tôi cần chỉ định một số văn bản tiêu chuẩn.

Tôi sẽ rất vui vì sự giúp đỡ của bạn.

Cảm ơn
Dù lượn
đáp lại
Report
0
0
Armin
Armin
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào để thêm ví dụ trang 2 từ sổ làm việc dưới dạng pdf?
đáp lại
0
0
pha lê
pha lê     Armin
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Armin,
Trước tiên, bạn cần mở Trang tính 2 trong sổ làm việc của mình, sau đó chạy mã VBA với các bước trên để tải xuống.
đáp lại
Report
0
0
Tom H
Tom H
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào để chỉnh sửa tập lệnh VBA ở trên để tên tệp được lưu dưới dạng một ô cụ thể được chọn trong trang tính hiện tại, ví dụ: ô A1?
đáp lại
0
0
pha lê
pha lê     Tom H
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào Tom.
Xin lỗi không thể giúp với điều này.
Chào mừng bạn đến đăng bất kỳ câu hỏi nào trong diễn đàn của chúng tôi: https://www.extendoffice.com/forum.html
Bạn sẽ nhận được nhiều hỗ trợ về Excel hơn từ những người yêu thích Excel chuyên nghiệp hoặc những người hâm mộ Excel khác.
đáp lại
Report
0
0
james
james
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, làm cách nào để lưu và gửi pdf với tên sổ làm việc với mã VBA hiện tại? tôi sử dụng cái gì thay vì xSht.Name
đáp lại
0
0
pha lê
pha lê     james
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi James,
Bạn có muốn gửi trang tính đang hoạt động dưới dạng pdf và đặt tên nó là tên sổ làm việc không?
đáp lại
Report
0
0
Ranga
Ranga
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cảm ơn nó hoạt động.
đáp lại
0
0
Jason
Jason
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào để tôi xóa pdf đã lưu sau khi gửi qua email?
đáp lại
0
0
pha lê
pha lê     Jason
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào Jason,
Xin lỗi không thể giúp bạn với điều đó được nêu ra. Bạn cần xóa thủ công sau khi gửi email.
đáp lại
Report
0
0
lẻ-Inge
lẻ-Inge
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào bạn,

Có thể tìm thấy tên cho pdf từ một ô không? Bán tại. Ô H4


Và trong Ô H4, tôi muốn nó thu thập từ ba ô khác nhau. Điều này có khả thi không?
đáp lại
0
0
Taylor
Taylor     lẻ-Inge
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Điều này là khả thi. Tạo các biến riêng biệt để giữ giá trị từ các ô và sau đó sử dụng các biến đó khi thiết lập xFolder.
Tôi đã sử dụng giá trị từ một ô trong trang tính của mình cộng với ngày hôm nay. Tuy nhiên, bạn có thể dễ dàng thực hiện nhiều giá trị ô.

Đây là những gì tôi đã thêm:
Dim xMemberName dưới dạng chuỗi
Dim xFileDate dưới dạng chuỗi

xMemberName = Range ("H3"). Giá trị
xFileDate = Định dạng (Bây giờ, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
đáp lại
0
0
Sora
Sora     Taylor
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi gặp lỗi khi thử cái này, tôi nên đặt cái này ở đâu trong mã?
đáp lại
0
0
Kishore
Kishore
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Crystal,



Nó thực sự tuyệt vời và hoạt động hoàn hảo đối với tôi. Cần thêm trợ giúp để thêm:

1. trong "Nội dung", tôi muốn cung cấp liên kết đến ô cụ thể của trang tính Hoạt động. Hơn nữa Muốn in đậm văn bản.

Cảm ơn

Trân trọng

Kishore kumar
đáp lại
Report
0
0
pha lê
pha lê     Kishore
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào,

Ý của bạn là tự động thêm giá trị ô vào mailbody và in đậm nó? Giả sử bạn thêm giá trị của C4 vào nội dung thư. Vui lòng áp dụng mã dưới đây.

Sub Saveaspdfandsend ()

Dim xSht dưới dạng bảng tính

Làm mờ xFileDlg dưới dạng FileDialog

Dim xFolder dưới dạng chuỗi

Dim xYesorNo dưới dạng số nguyên

Làm mờ xOutlookObj dưới dạng đối tượng

Làm mờ xEmailObj dưới dạng đối tượng

Dim xUsedRng As Range



Đặt xSht = ActiveSheet

Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)



Nếu xFileDlg.Show = True Thì

xFolder = xFileDlg.SelectedItems (1)

Khác

MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"

Thoát Sub

Cuối Nếu

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



'Kiểm tra xem tệp đã tồn tại chưa

Nếu Len (Dir (xFolder))> 0 Thì

xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _

vbYesNo + vbQuestion, "Tệp Tồn tại")

On Error Resume Next

Nếu xYesorNo = vbYes Thì

Giết xFolder

Khác

MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _

& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"

Thoát Sub

Cuối Nếu

Nếu Err.Number <> 0 Thì

MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _

& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"

Thoát Sub

Cuối Nếu

Cuối Nếu



Đặt xUsedRng = xSht.UsedRange

Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì

'Lưu dưới dạng tệp PDF

xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard



'Tạo email Outlook

Đặt xOutlookObj = CreateObject ("Outlook.Application")

Đặt xEmailObj = xOutlookObj.CreateItem (0)

Với xEmailObj

.Trưng bày

.To = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Attachments.Add xFolder

.HTMLBody = "
"& Phạm vi (" C4 ") & .HTMLBody

Nếu DisplayEmail = Sai thì

'.Gửi

Cuối Nếu

Kết thúc với

Khác

MsgBox "Không được để trống trang tính đang hoạt động"

Thoát Sub

Cuối Nếu

End Sub
đáp lại
Report
0
0
Geoff
Geoff
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Nếu tôi muốn nó tự động lưu trong một thư mục cụ thể mỗi lần (loại bỏ nhu cầu người dùng chọn thư mục), tôi sẽ làm điều đó như thế nào?
Bán tại. C: Hóa đơn / Bắc Mỹ / Khách hàng
Giúp đỡ được đánh giá rất cao.
đáp lại
0
0
pha lê
pha lê     Geoff
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Geoff,
Ý của bạn là lưu trang tính dưới dạng tệp pdf và lưu vào một thư mục cụ thể mà không cần gửi?
đáp lại
Report
0
0
Jeremy
Jeremy     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi nghĩ Geoff có nghĩa là có thể xác định một thư mục cụ thể trong mã mà pdf được lưu vào mỗi lần thay vì phải chọn vị trí theo cách thủ công. Bản pdf sau đó sẽ được gửi qua email từ thư mục cụ thể đó.
đáp lại
0
0
pha lê
pha lê     Jeremy
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cảm ơn Jeremy.
đáp lại
Report
0
0
pha lê
pha lê     Geoff
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Geoff, Nếu bạn muốn tự động lưu tệp pdf vào một thư mục cụ thể thay vì chọn vị trí theo cách thủ công, vui lòng thử mã bên dưới. Đừng quên thay đổi đường dẫn thư mục trong mã.
Sub SaveAsPDFandSend ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xPath dưới dạng chuỗi
Đặt xSht = ActiveSheet
xPath = "C: \ Users \ Win10x64Test \ Desktop \ worksheet sang pdf"" here "workshet to pdf" là thư mục đích để lưu các tệp pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Alison
Alison
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Mã này hoạt động tuyệt vời ngoại trừ tôi muốn lưu trang tính dưới dạng tên trang tính + ngày tháng (tức là. Sheet1 ngày 1 tháng 2020 năm XNUMX); trên màn hình của người dùng (điều này sẽ được nhiều người sử dụng và đường dẫn của họ có thể khác nhau một chút). Nếu có thể, tôi cũng muốn nhúng .jpg vào nội dung .. JPG nằm cả bên trong trang tính (bên ngoài vùng in) và hình ảnh được lưu trữ trên máy chủ dùng chung .. mặc dù đường dẫn đến máy chủ khác nhau người dùng (đối với hầu hết nó là ổ đĩa "T" đối với một số ổ đĩa "U")
điều này có thể được thực hiện? xin vui lòng và cảm ơn bạn một triệu lần.
đáp lại
0
0
Deepak
Deepak
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web

Xin chào, nó hoạt động rất tốt, cảm ơn bạn đã chia sẻ, Chỉ cần một sự trợ giúp.
Nếu tôi muốn lưu tệp PDF với tên tùy chỉnh (tùy chọn nhập tên tệp trong hộp thoại SaveAs), khi người dùng sử dụng tùy chọn này trong mẫu biểu mẫu nơi biểu mẫu được lưu dưới dạng PDF với tên duy nhất.
đáp lại
Report
0
0
pha lê
pha lê     Deepak
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Vui lòng thử mã VBA bên dưới. Sau khi chạy mã, hãy chọn một thư mục để lưu tệp PDF, sau đó một hộp thoại sẽ hiện ra để bạn nhập tên tệp. Sub Saveaspdfandsend ()
'Cập nhật Extendoffice 20210209
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xStrName dưới dạng chuỗi
Dim xV dưới dạng biến thể

Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xStrName = ""
xV = Application.InputBox ("Vui lòng nhập tên tệp:", "Kutools cho Excel",,,,, 2)
Nếu xV = Sai thì
Thoát Sub
Cuối Nếu
xStrName = xV
Nếu xStrName = "" Thì
MsgBox ("Không có tên tệp nào được nhập, quá trình thoát!")
Thoát Sub
Cuối Nếu

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
mleczus94
mleczus94
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào,
Nếu tôi có hai trang tính trong tệp và tôi muốn chạy macro này trên một trang tính (bằng cách nhấn nút) nhưng gửi macro khác, làm cách nào tôi có thể lấy được?
đáp lại
Report
0
0
Huh
Huh
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, tôi muốn lưu tệp này vào một vị trí tệp nhất định, với tên dựa trên vallue trong ô C30. Tôi đã thử một vài tùy chọn nhưng vẫn gặp lỗi.
đáp lại
0
0
pha lê
pha lê     Huh
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi hein, Đoạn mã dưới đây có thể có ích. Sau khi chạy mã, hãy chọn một thư mục nhất định để lưu tệp PDF, sau đó một hộp thoại sẽ hiện ra để bạn nhập tên tệp. Sub Saveaspdfandsend ()
'Cập nhật Extendoffice 20210209
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xStrName dưới dạng chuỗi
Dim xV dưới dạng biến thể

Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xStrName = ""
xV = Application.InputBox ("Vui lòng nhập tên tệp:", "Kutools cho Excel",,,,, 2)
Nếu xV = Sai thì
Thoát Sub
Cuối Nếu
xStrName = xV
Nếu xStrName = "" Thì
MsgBox ("Không có tên tệp nào được nhập, quá trình thoát!")
Thoát Sub
Cuối Nếu

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Hầm
Hầm     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cảm ơn vì điều đó, điều đó thật tuyệt, nhưng tôi muốn trang tính được đặt tên theo ô A1 trên trang tính 1. Nơi lưu theo ô A1 trên trang tính 2, ví dụ C: \ Users \ peete \ Dropbox \ Screenshots và gửi email tới địa chỉ email trên A3 sheet 2 những gì tôi đã tìm ra.
đáp lại
0
0
HeinPeeters
HeinPeeters     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cảm ơn vì điều đó, điều đó thật tuyệt, nhưng tôi muốn trang tính được đặt tên theo ô A1 trên trang tính 1. Nơi để lưu theo ô A1 trên trang tính 2, ví dụ C: \ Users \ peete \ Dropbox \ Screenshots, nhưng có thể thay đổi khi bằng cách sử dụng tệp và gửi email đến địa chỉ email trên A3 sheet 2, những gì tôi đã tìm ra.
đáp lại
Report
0
0
BenSpo
BenSpo
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi pha lê , mã excelent, cảm ơn bạn đã chia sẻ.
đáp lại
Report
0
0
pha lê
pha lê     BenSpo
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Mã VBA dưới đây có thể giúp bạn một điều gì đó, vui lòng thử. Ở dòng thứ mười hai của mã, vui lòng thay thế tên trang tính bằng tên trang tính thực tế trong trường hợp của bạn.
Sub Saveaspdfandsend1 ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo, I, xNum dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xArrShetts dưới dạng biến thể
Làm mờ xPDFNameAddress dưới dạng chuỗi
Làm mờ xStr dưới dạng chuỗi
xArrShetts = Mảng ("kiểm tra", "Trang tính 1", "Trang tính 2") 'Nhập tên trang tính bạn sẽ gửi dưới dạng tệp pdf kèm theo dấu ngoặc kép và phân tách chúng bằng dấu phẩy. Đảm bảo rằng không có ký tự đặc biệt như \ /: "* <> | trong tên tệp.

Đối với I = 0 Đến UBound (xArrShetts)
On Error Resume Next
Đặt xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
Nếu xSht.Name <> xArrShetts (I) Thì
MsgBox "Không tìm thấy trang tính, thoát hoạt động:" & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Sau


Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
'Kiểm tra xem tệp đã tồn tại chưa
xYesorNo = MsgBox ("Nếu các tệp trùng tên tồn tại trong thư mục đích, hậu tố số sẽ tự động được thêm vào tên tệp để phân biệt các tệp trùng lặp" & vbCrLf & vbCrLf & "Bấm Có để tiếp tục, bấm Không để hủy", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
If xYesorNo <> vbYes Then Exit Sub
Đối với I = 0 Đến UBound (xArrShetts)
Đặt xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
While Not (Dir (xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xStr, Quality: = xlQualityStandard
Khác

Cuối Nếu
xArrShetts (I) = xStr
Sau

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = "????"
Đối với I = 0 Đến UBound (xArrShetts)
.Attachments.Add xArrShetts (I)
Sau
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
End Sub
đáp lại
Report
0
0
Berneé Rudolph
Berneé Rudolph     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Một thay đổi mà tôi đang gặp khó khăn là tạo một email riêng cho mỗi tài liệu pdf được tạo.
đáp lại
0
0
pha lê
pha lê     Berneé Rudolph
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Để tạo một email riêng cho từng tài liệu pdf, bạn có thể chạy thủ công VBA được cung cấp trong bài đăng trong các trang tính khác nhau để hoàn thành việc này.
đáp lại
Report
0
0
Berneé Rudolph
Berneé Rudolph     pha lê
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi có hơn 100 trang tính trong sổ làm việc, điều này sẽ dẫn đến việc tôi phải chạy VBA hơn 100 lần, điều này gây tốn thời gian.  
Tôi đã quản lý để chia sổ làm việc của mình thành nhiều trang tính và sau đó tôi có thể chuyển đổi từng trang tính thành một tài liệu PDF riêng lẻ.
Giải pháp tôi đang tìm kiếm là gửi email từng tài liệu PDF riêng biệt trong khi quá trình trên đang chạy.
Dưới đây là VBA mà tôi hiện đang chạy:
Sub Saveaspdfandsend1 ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo, I, xNum dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xArrShetts dưới dạng biến thể
Làm mờ xPDFNameAddress dưới dạng chuỗi
Làm mờ xStr dưới dạng chuỗi
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") 'Nhập tên trang tính bạn sẽ gửi dưới dạng tệp pdf kèm theo dấu ngoặc kép và phân tách chúng bằng dấu phẩy. Đảm bảo rằng không có ký tự đặc biệt như \ /: "* <> | trong tên tệp.

Đối với I = 0 Đến UBound (xArrShetts)
On Error Resume Next
Đặt xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
Nếu xSht.Name <> xArrShetts (I) Thì
MsgBox "Không tìm thấy trang tính, thoát hoạt động:" & vbCrLf & vbCrLf & xArrShetts (I), vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Sau


Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
'Kiểm tra xem tệp đã tồn tại chưa
xYesorNo = MsgBox ("Nếu các tệp trùng tên tồn tại trong thư mục đích, hậu tố số sẽ tự động được thêm vào tên tệp để phân biệt các tệp trùng lặp" & vbCrLf & vbCrLf & "Bấm Có để tiếp tục, bấm Không để hủy", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
If xYesorNo <> vbYes Then Exit Sub
Đối với I = 0 Đến UBound (xArrShetts)
Đặt xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
While Not (Dir (xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Wend
Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xStr, Quality: = xlQualityStandard
Khác

Cuối Nếu
xArrShetts (I) = xStr
Sau

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "????"
Đối với I = 0 Đến UBound (xArrShetts)
On Error Resume Next
.Attachments.Add xArrShetts (I)
Sau
Nếu DisplayEmail = Sai thì
.Gửi
Thoát Sub
Cuối Nếu
Kết thúc với


End Sub
đáp lại
0
0
Tori
Tori
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào @crystal
Đây là điều tuyệt vời - điều quan trọng mà tôi đang đấu tranh là tên tệp - Tôi muốn tên tệp được lấy từ một ô trong trang tính hơn là sử dụng tên tab. Tôi đã chỉnh sửa mã để lưu tự động vào một thư mục được chỉ định nhưng đang gặp khó khăn với tên tệp.
Bất kỳ sự giúp đỡ nào bạn có thể cung cấp xin vui lòng?
đáp lại
0
0
pha lê
pha lê     Tori
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Tori, Nếu bạn muốn đặt tên tệp PDF bằng một giá trị ô cụ thể, vui lòng thử mã sau. Sau khi chạy mã và chọn thư mục để lưu tệp, một hộp thoại khác bật lên, vui lòng chọn ô mà bạn sẽ sử dụng giá trị như tên của tệp PDF, sau đó bấm OK để hoàn tất.
Sub Saveaspdfandsend2 ()
'Cập nhật Extendoffice 20210521
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng, xRgInser As Range
Dim xB dưới dạng Boolean
Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xB = Đúng
On Error Resume Next
Trong khi xB
Đặt xRgInser = Không có gì
Đặt xRgInser = Application.InputBox ("Chọn một ô mà bạn sẽ sử dụng giá trị để đặt tên cho tệp PDF:", "Kutools cho Excel",,,,, 8)
Nếu xRgInser không có gì thì
MsgBox "Không có ô nào được chọn, hãy thoát khỏi thao tác!", VbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Nếu xRgInser.Text = "" Thì
MsgBox "Ô đã chọn trống, vui lòng chọn lại!", VbInformation, "Kutools cho Excel"
Khác
xB = Sai
Cuối Nếu
Wend

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

'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Makeeuropeanu
Makeeuropeanu
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, tôi cần một cái gì đó tương tự vì vậy đây là những gì tôi nhận được. Nó lấy ngày hiện tại và tạo một thư mục mới có tên ngày ở một vị trí cụ thể. Nó đặt pdf bên trong vị trí mới đó, sau đó đính kèm pdf vào một email mới. Hoạt động như một điều trị. Tôi chỉ là người mới bắt đầu nên xin thứ lỗi nếu nó trông giống như một mớ hỗn độn. : D
Sub PDFTOEMAIL ()
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xPath dưới dạng chuỗi
Dim xOutMsg dưới dạng Chuỗi
Dim sFolderName dưới dạng chuỗi, sFolder dưới dạng chuỗi
Dim sFolderPath dưới dạng chuỗi

Đặt xSht = ActiveSheet
xFileDate = Định dạng (Bây giờ, "dd-mm-yyyy")
sFolder = "C:" 'đây là nơi bạn có một thư mục chính
sFolderName = "Tuần kết thúc" + Định dạng (Bây giờ, "dd-mm-yyyy") thư mục sẽ được tạo trong thư mục chính với tên Kết thúc tuần và ngày hiện tại
sFolderPath = "C:" & thư mục chính của sFolderName một lần nữa để tạo đường dẫn mới bao gồm cả thư mục mới
Đặt oFSO = CreateObject ("Scripting.FileSystemObject")
Nếu oFSO.FolderExists (sFolderPath) Thì
MsgBox "Thư mục đã tồn tại!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Khác
MkDir sFolderPath
MsgBox "Thư mục mới đã được tạo!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Cuối Nếu
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
xOutMsg = " Vui lòng tìm phần đính kèm Email và tệp đính kèm này đã được tạo tự động "
'thêm ghi chú rằng email được tạo tự động

Với xEmailObj
.Trưng bày
.To = "" 'thêm email của riêng bạn
.CC = ""
.Subject = xSht.Name + "PDF cho tuần kết thúc" + xFileDate + "- Location" 'chủ đề bao gồm tên trang tính, pdf, ngày tháng và vị trí, bạn có thể chỉnh sửa điều này nếu cần
.Attachments.Add xFolder
.HTMLBody = xOutMsg & .HTMLBody
Nếu DisplayEmail = Sai thì
'.Gửi <--- Tại đây nếu bạn xóa dấu nháy đơn, email sẽ được gửi tự động, vì vậy hãy cẩn thận
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
Report
0
0
Nicole
Nicole
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào để chỉnh sửa mã này để chỉ lưu các ô ("a1: r99") để lưu dưới dạng PDF. Tôi có thêm những thứ mà tôi không muốn trong tài liệu PDF của mình.
Sub Saveaspdfandsend ()
'Cập nhật Extendoffice 20210209
Dim xSht dưới dạng bảng tính
Làm mờ xFileDlg dưới dạng FileDialog
Dim xFolder dưới dạng chuỗi
Dim xYesorNo dưới dạng số nguyên
Làm mờ xOutlookObj dưới dạng đối tượng
Làm mờ xEmailObj dưới dạng đối tượng
Dim xUsedRng As Range
Dim xStrName dưới dạng chuỗi
Dim xV dưới dạng biến thể

Đặt xSht = ActiveSheet
Đặt xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFileDlg.Show = True Thì
xFolder = xFileDlg.SelectedItems (1)
Khác
MsgBox "Bạn phải chỉ định một thư mục để lưu tệp PDF vào." & vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Phải Chỉ định Thư mục Đích"
Thoát Sub
Cuối Nếu
xStrName = ""
xV = Application.InputBox ("Vui lòng nhập tên tệp:", "Kutools cho Excel",,,,, 2)
Nếu xV = Sai thì
Thoát Sub
Cuối Nếu
xStrName = xV
Nếu xStrName = "" Thì
MsgBox ("Không có tên tệp nào được nhập, quá trình thoát!")
Thoát Sub
Cuối Nếu

xFolder = xFolder + "\" + xStrName + ".pdf"
'Kiểm tra xem tệp đã tồn tại chưa
Nếu Len (Dir (xFolder))> 0 Thì
xYesorNo = MsgBox (xFolder & "đã tồn tại." & vbCrLf & vbCrLf & "Bạn có muốn ghi đè lên nó không?", _
vbYesNo + vbQuestion, "Tệp Tồn tại")
On Error Resume Next
Nếu xYesorNo = vbYes Thì
Giết xFolder
Khác
MsgBox "nếu bạn không ghi đè lên tệp PDF hiện có, tôi không thể tiếp tục." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Thoát macro"
Thoát Sub
Cuối Nếu
Nếu Err.Number <> 0 Thì
MsgBox "Không thể xóa tệp hiện có. Hãy đảm bảo rằng tệp không được mở hoặc được bảo vệ ghi." _
& vbCrLf & vbCrLf & "Nhấn OK để thoát macro này.", vbCritical, "Không thể xóa tệp"
Thoát Sub
Cuối Nếu
Cuối Nếu

Đặt xUsedRng = xSht.UsedRange
Nếu Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 Thì
'Lưu dưới dạng tệp PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF, Filename: = xFolder, Quality: = xlQualityStandard

'Tạo email Outlook
Đặt xOutlookObj = CreateObject ("Outlook.Application")
Đặt xEmailObj = xOutlookObj.CreateItem (0)
Với xEmailObj
.Trưng bày
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
Nếu DisplayEmail = Sai thì
'.Gửi
Cuối Nếu
Kết thúc với
Khác
MsgBox "Không được để trống trang tính đang hoạt động"
Thoát Sub
Cuối Nếu
End Sub
đáp lại
0
0
RLF
RLF     Nicole
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, tôi vừa thử mã này trên một trong các trang tính của mình và tôi đã đặt vùng in nên nội dung thừa ở dưới cùng không xuất hiện trong pdf. Thử nó!
đáp lại
0
0
Rod Bennett
Rod Bennett
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi
Rất cảm ơn Mã nhưng có thể lưu tệp PDF tự động vào cùng vị trí với tệp Excel đang hoạt động và có cùng tên tệp với tệp Excel đang hoạt động không?
Rất cám ơn.
Gậy
đáp lại
0
0
Không có bình luận nào được đăng ở đây
Tải thêm
Để lại ý kiến ​​của bạn
Khách
Đăng với tư cách khách
Đăng nhập
×
Đánh giá bài viết này:
Xóa và làm lại
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL