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

Jak zapisać arkusz roboczy jako plik PDF i wysłać go e-mailem jako załącznik za pośrednictwem programu Outlook?

W niektórych przypadkach może być konieczne wysłanie arkusza jako pliku PDF za pośrednictwem programu Outlook. Zwykle musisz ręcznie zapisać arkusz jako plik PDF, a następnie utworzyć nową wiadomość e-mail z tym plikiem PDF jako załącznikiem w programie Outlook i na koniec wysłać. Wykonywanie tego ręcznie krok po kroku jest czasochłonne. W tym artykule pokażemy, jak szybko zapisać arkusz roboczy jako plik PDF i wysłać go automatycznie jako załącznik za pośrednictwem programu Outlook w programie Excel.

Zapisz arkusz jako plik PDF i wyślij go pocztą e-mail jako załącznik z kodem VBA


Zapisz arkusz jako plik PDF i wyślij go pocztą e-mail jako załącznik z kodem VBA

Możesz uruchomić poniższy kod VBA, aby automatycznie zapisać aktywny arkusz jako plik PDF, a następnie wysłać go pocztą e-mail jako załącznik za pośrednictwem programu Outlook. Wykonaj następujące czynności.

1. Otwórz arkusz roboczy, który zapiszesz jako PDF i wyślesz, a następnie naciśnij inny + F11 klawisze jednocześnie, aby otworzyć Microsoft Visual Basic for Applications okno.

2. w Microsoft Visual Basic for Applications okno, kliknij wstawka > Moduł. Następnie skopiuj i wklej poniższy kod VBA do pliku Kod okno. Zobacz zrzut ekranu:

Kod VBA: Zapisz arkusz jako plik PDF i wyślij go pocztą e-mail jako załącznik

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. wciśnij F5 klucz do uruchomienia kodu. w Przeglądaj W oknie dialogowym wybierz folder do zapisania tego pliku PDF, a następnie kliknij OK przycisk.

Uwagi:

1. Teraz aktywny arkusz roboczy jest zapisywany jako plik PDF. Plik PDF nosi nazwę arkusza.
2. Jeśli aktywny arkusz jest pusty, po kliknięciu przycisku pojawi się okno dialogowe, jak na poniższym zrzucie ekranu OK przycisk.

4. Teraz jest tworzony nowy e-mail programu Outlook i widać, że plik PDF jest wymieniony jako załącznik w załączonym pliku. Zobacz zrzut ekranu:

5. Utwórz tę wiadomość e-mail, a następnie ją wyślij.
6. Ten kod jest dostępny tylko wtedy, gdy używasz programu Outlook jako programu pocztowego.

Z łatwością zapisz arkusz roboczy lub wiele arkuszy roboczych jako oddzielne pliki PDF naraz:

Podróż Ruta de la Plata w liczbach Podziel skoroszyt użyteczność Kutools dla programu Excel może pomóc w łatwym zapisaniu arkusza roboczego lub wielu arkuszy roboczych jako oddzielnych plików PDF jednocześnie, jak pokazano poniżej. Pobierz i wypróbuj teraz! (30-dzień bezpłatny szlak)


Powiązane artykuły:


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
Sortuj komentarze według
Komentarze (63)
Znamionowy 5 z 5 · 1 oceny
Ten komentarz został zminimalizowany przez moderatora na stronie
To działa dla mnie świetnie, ale czy istnieje sposób, aby wybrać lokalizację folderu automatycznie, zamiast wybierać ręcznie? Mam nadzieję, że zrobię to dla 40 arkuszy na raz.
Ten komentarz został zminimalizowany przez moderatora na stronie
Mam również nadzieję na odpowiedź na ten problem! Dzięki za pomoc!
Ten komentarz został zminimalizowany przez moderatora na stronie
Próbowałem wkleić to do nowego modułu i otrzymuję błąd kompilacji: Nie zdefiniowano Sub lub Function. Proszę pomóż.
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Darrenie,
Z której wersji pakietu Office korzystasz?
Ten komentarz został zminimalizowany przez moderatora na stronie
Biuro 360
Ten komentarz został zminimalizowany przez moderatora na stronie
Ten sam problem
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak edytować powyższy skrypt VBA, aby dodał sygnaturę daty i godziny do nazwy pliku, w ten sposób nie nadpisując tego, co już jest zapisane?
Ten komentarz został zminimalizowany przez moderatora na stronie
Drogi Michale,
Uruchom poniższy kod VBA, aby rozwiązać problem.

Sub Zapisz jako PDF i wyślij()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xStr jako ciąg

Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xStr = Format(Teraz(), "rrrr-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + "-" + xStr + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

To jest naprawdę świetne i dla mnie działa idealnie. Potrzebujesz dodatkowej pomocy, aby dodać:

1. w "Do" chcę podać link do konkretnej komórki aktywnego arkusza tak jak w CC a w BCC chcę dodać link do aktywnego arkusza
2. w treści e-maila muszę podać jakiś standardowy tekst.

Będę dla ciebie pełen za twoją pomoc.

Podziękowania
Parag
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Parag Somani,
Poniższy kod VBA może ci pomóc. Zmień pola .Do, .CC, .BCC i .Body w zależności od potrzeb.

Sub Zapisz jako PDF i wyślij()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xStr jako ciąg

Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xStr = Format(Teraz(), "rrrr-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = Zakres("A8")
.CC = Zakres("A9")
.BCC = Zakres("A10")
.Temat = xSht.Nazwa + "-" + xStr + ".pdf"
.Body = "Kochanie" _
& vbNowaLinia & vbNowaLinia & _
„To jest testowy e-mail” & _
"wysyłanie w Excelu"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Próbowałem użyć Range dla "Do", "CC", po prostu nie pobiera wartości z wyznaczonej komórki. Czy możesz w tym pomóc?
Dzięki,
Mehul
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

To jest naprawdę świetne i dla mnie działa idealnie. Potrzebujesz dodatkowej pomocy, aby dodać:

1. w "Do" chcę podać link do konkretnej komórki aktywnego arkusza tak jak w CC a w BCC chcę dodać link do aktywnego arkusza
2. w treści e-maila muszę podać jakiś standardowy tekst.

Będę dla ciebie pełen za twoją pomoc.

Podziękowania
Parag
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

To jest naprawdę świetne i dla mnie działa idealnie. Potrzebujesz dodatkowej pomocy, aby dodać:

1. w "Do" chcę podać link do konkretnej komórki aktywnego arkusza tak jak w CC a w BCC chcę dodać link do aktywnego arkusza
2. w treści e-maila muszę podać jakiś standardowy tekst.

Będę dla ciebie pełen za twoją pomoc.

Podziękowania
Parag
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak dodać np. arkusz 2 ze skoroszytu jako pdf?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Armin,
Musisz najpierw otworzyć arkusz 2 w skoroszycie, a następnie uruchomić kod VBA z powyższymi krokami, aby go usunąć.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak edytować powyższy skrypt VBA, aby nazwa pliku została zapisana jako konkretna komórka wybrana w bieżącym arkuszu, na przykład komórka A1?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Tom.
Przepraszam, nie mogę w tym pomóc.
Zapraszamy do zadawania pytań na naszym forum: https://www.extendoffice.com/forum.html
Otrzymasz więcej wsparcia Excela od naszych profesjonalistów Excela lub innych fanów Excela.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, jak mogę zapisać i wysłać plik PDF z nazwą skoroszytu z aktualnym kodem VBA? czego używam zamiast xSht.Name?
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi James,
Czy chcesz wysłać aktywny arkusz jako pdf i nazwać go jako nazwę skoroszytu?
Ten komentarz został zminimalizowany przez moderatora na stronie
Dzięki to działa.
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak mogę zmusić go do usunięcia zapisanego pliku PDF po wysłaniu go e-mailem?
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi Jason,
Przepraszamy, nie mogę ci jeszcze w tym pomóc. Musisz ręcznie usunąć go po wysłaniu go e-mailem.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Czy można znaleźć nazwę dla pdf z komórki? Były. Komórka H4


A w Cell H4 chcę go zebrać z trzech różnych komórek. czy to możliwe?
Ten komentarz został zminimalizowany przez moderatora na stronie
To jest możliwe. Utwórz oddzielne zmienne, aby przechowywać wartość z komórek, a następnie użyj tych zmiennych podczas ustawiania xFolder.
Użyłem wartości z komórki w moim arkuszu plus dzisiejsza data. Możesz jednak łatwo zrobić wiele wartości komórek.

Oto co dodałem:
Dim xMemberName jako ciąg
Dim xFileDate jako ciąg

xMemberName = Zakres("H3").Wartość
xFileDate = Format (teraz, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
Ten komentarz został zminimalizowany przez moderatora na stronie
Otrzymuję błąd, kiedy próbuję tego, gdzie w kodzie należy to umieścić?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,



To jest naprawdę świetne i dla mnie działa idealnie. Potrzebujesz dodatkowej pomocy, aby dodać:

1. w "Body" chcę podać link do konkretnej komórki aktywnego arkusza. Dalej Chciałbym pogrubić tekst.

Podziękowania

pozdrowienia

Kishore Kumar
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Czy masz na myśli automatyczne dodanie wartości komórki do treści wiadomości i pogrubienie jej? Przypuśćmy, że do treści wiadomości dodasz wartość C4. Zastosuj poniższy kod.

Sub Zapisz jako PDF i wyślij()

Dim xSht jako arkusz

Dim xFileDlg jako okno pliku

Dim xFolder jako ciąg

Dim xTak lub Nie jako liczba całkowita

Dim xOutlookObj jako obiekt

Dim xEmailObj jako obiekt

Dim xUsedRng jako zakres



Ustaw xSht = Aktywny arkusz

Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Jeśli xFileDlg.Show = True Wtedy

xFolder = xFileDlg.SelectedItems(1)

Więcej

MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"

Exit Sub

End If

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



'Sprawdź, czy plik już istnieje

Jeśli Len(Dir(xFolder)) > 0 Wtedy

xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _

vbYesNo + vbQuestion, "Plik istnieje")

On Error Resume Next

Jeśli xTaklubNie = vbTak Wtedy

Zabij xFolder

Więcej

MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _

& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"

Exit Sub

End If

Jeśli Err.Number <> 0 Wtedy

MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _

& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"

Exit Sub

End If

End If



Ustaw xUsedRng = xSht.UsedRange

Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy

„Zapisz jako plik PDF”

xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard



'Utwórz e-mail programu Outlook

Ustaw xOutlookObj = CreateObject("Outlook.Application")

Ustaw xEmailObj = xOutlookObj.CreateItem(0)

Z xEmailObj

.Pokaz

.Do = ""

.CC = „”

.Temat = xSht.Nazwa + ".pdf"

.Załączniki.Dodaj xFolder

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

Jeśli DisplayEmail = False, to

'.Wysłać

End If

Kończyć z

Więcej

MsgBox "Aktywny arkusz nie może być pusty"

Exit Sub

End If

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Gdybym chciał, aby za każdym razem automatycznie zapisywał się w określonym folderze (eliminując potrzebę wybierania folderu przez użytkownika), jak bym to zrobił?
Były. C: Faktury/Ameryka Północna/Klienci
Pomoc jest mile widziana.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Geoff,
Czy masz na myśli zapisanie arkusza roboczego jako pliku pdf i zapisanie go w określonym folderze bez wysyłania?
Ten komentarz został zminimalizowany przez moderatora na stronie
Myślę, że Geoff oznacza możliwość określenia konkretnego folderu w kodzie, w którym plik pdf jest za każdym razem zapisywany, zamiast konieczności ręcznego wybierania lokalizacji. Plik PDF jest następnie wysyłany e-mailem z tego konkretnego folderu.
Ten komentarz został zminimalizowany przez moderatora na stronie
Dziękuję Jeremy.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Geoff, Jeśli chcesz automatycznie zapisać plik PDF w określonym folderze, zamiast ręcznie wybierać lokalizację, wypróbuj poniższy kod. Nie zapomnij zmienić ścieżki folderu w kodzie.
Sub Zapisz jako PDF i wyślij()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xPath jako ciąg
Ustaw xSht = Aktywny arkusz
xŚcieżka = "C:\Users\Win10x64Test\Desktop\worksheet do pdf" 'tutaj "arkusz do pdf" to folder docelowy do zapisywania plików pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Ten kod działa świetnie, z wyjątkiem tego, że chcę, aby arkusz został zapisany jako nazwa arkusza + data (tj. Arkusz1 1 października 2020 r.); na pulpicie użytkownika (będzie z niego korzystać wiele osób, a ich ścieżki mogą się nieznacznie różnić). Jeśli to możliwe, chcę również osadzić plik .jpg w ciele.. JPG znajduje się zarówno wewnątrz arkusza roboczego (poza obszarem drukowania), jak i obraz jest przechowywany na serwerze współdzielonym.. chociaż ścieżka do serwera różni się w zależności od użytkownik (dla większości jest to dysk "T" dla niektórych dysk "U")
czy można to zrobić? proszę i dziękuję milion razy.
Ten komentarz został zminimalizowany przez moderatora na stronie

Cześć , działa świetnie, dziękuję za udostępnienie, Potrzebuję tylko jednej pomocy.
Jeśli chcę zapisać plik PDF z niestandardową nazwą (opcja wpisania nazwy pliku w oknie dialogowym Zapisz jako), jako użytkownik użyj tej opcji w szablonie formularza, w którym formularze zapisane jako PDF z unikalną nazwą.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, wypróbuj poniższy kod VBA. Po uruchomieniu kodu wybierz folder, w którym chcesz zapisać plik PDF, a następnie pojawi się okno dialogowe, w którym należy wpisać nazwę pliku. Sub Zapisz jako PDF i wyślij()
'Aktualizowany przez Extendoffice 20210209
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xStrName jako ciąg
Dim xV jako wariant

Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Wprowadź nazwę pliku:", "Kutools for Excel", , , , , , 2)
Jeśli xV = Fałsz Wtedy
Exit Sub
End If
xStrNazwa = xV
Jeśli xStrName = "" Wtedy
MsgBox ("Nie wprowadzono nazwy pliku, kończę proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,
Jeśli mam w pliku dwa arkusze i chciałbym uruchomić to makro na jednym arkuszu (naciskając przycisk), a wysłać inny, jak mogę je zdobyć?
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, chciałbym zapisać to w określonej lokalizacji pliku, z nazwą opartą na wartości w komórce C30. Próbowałem kilku opcji, ale wciąż pojawiają się błędy.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć hein, poniższy kod może pomóc. Po uruchomieniu kodu wybierz określony folder, aby zapisać plik PDF, a następnie pojawi się okno dialogowe, w którym należy wprowadzić nazwę pliku. Sub Zapisz jako PDF i wyślij()
'Aktualizowany przez Extendoffice 20210209
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xStrName jako ciąg
Dim xV jako wariant

Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Wprowadź nazwę pliku:", "Kutools for Excel", , , , , , 2)
Jeśli xV = Fałsz Wtedy
Exit Sub
End If
xStrNazwa = xV
Jeśli xStrName = "" Wtedy
MsgBox ("Nie wprowadzono nazwy pliku, kończę proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Dzięki za to, to świetnie, ale chcę, aby arkusz był nazwany zgodnie z komórką A1 na arkuszu 1. miejsce do zapisania zgodnie z A1 na arkuszu 2, na przykład C: \ Users \ peete \ Dropbox \ Screenshots i wyślij e-mail do adres e-mail na arkuszu A3 2, co już wypracowałem.
Ten komentarz został zminimalizowany przez moderatora na stronie
Dzięki za to, to świetnie, ale chcę, aby arkusz był nazwany zgodnie z komórką A1 na arkuszu 1. miejsce do zapisania zgodnie z A1 na arkuszu 2, na przykład C: \ Users \ peete \ Dropbox \ Screenshots, ale może się zmienić, kiedy za pomocą pliku i wyślij e-mail na adres e-mail na arkuszu A3 2, co już opracowałem.
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi kryształ , doskonały kod dzięki za udostępnienie. Czy istnieje sposób na wybranie wielu arkuszy (z tego samego skoroszytu), aby zapisać każdy z nich jako niezależny plik PDF, a następnie wysłać je wszystkie załączone w jednym e-mailu?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Poniższy kod VBA może ci wyświadczyć przysługę, spróbuj. W dwunastym wierszu kodu zastąp nazwy arkuszy rzeczywistymi nazwami arkuszy w twoim przypadku.
Sub Zapisz jakopdf i wyślij1()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTaklubNie, I, xNum Jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xArrShetts jako wariant
Dim xPDFNameAdres jako ciąg
Dim xStr jako ciąg
xArrShetts = Tablica ("test", „Arkusz1”, „Arkusz2”) 'Wprowadź nazwy arkuszy, które wyślesz jako pliki pdf ujęte w cudzysłów i oddziel je przecinkami. Upewnij się, że w nazwie pliku nie ma znaków specjalnych, takich jak \/:"*<>|.

Dla I = 0 do UBound(xArrShetts)
On Error Resume Next
Ustaw xSht = Aplikacja.ActiveWorkbook.Worksheets(xArrShetts(I))
If xSht.Name <> xArrShetts(I) Wtedy
MsgBox "Nie znaleziono arkusza roboczego, zakończ operację:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Dalej


Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
'Sprawdź, czy plik już istnieje
xYesorNo = MsgBox("Jeśli w folderze docelowym istnieją pliki o tej samej nazwie, do nazwy pliku zostanie automatycznie dodany przyrostek w celu rozróżnienia duplikatów" & vbCrLf & vbCrLf & "Kliknij Tak, aby kontynuować, kliknij Nie, aby anulować", _
vbYesNo + vbQuestion, "Plik istnieje")
Jeśli xYesorNo <> vbYes to zakończ Sub
Dla I = 0 do UBound(xArrShetts)
Ustaw xSht = Aplikacja.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xLiczba = 1
Chociaż nie (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xLiczba = xLiczba + 1
zastosować
Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xStr, Jakość:=xlQualityStandard
Więcej

End If
xArrShetts(I) = xStr
Dalej

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = "?????"
Dla I = 0 do UBound(xArrShetts)
.Załączniki.Dodaj xArrShetts(I)
Dalej
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Jedyną zmianą, z którą się zmagam, jest utworzenie osobnego e-maila dla każdego utworzonego dokumentu PDF.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, Aby utworzyć oddzielny e-mail dla każdego dokumentu PDF, możesz ręcznie uruchomić VBA dostarczony w poście w różnych arkuszach roboczych, aby to zrobić.
Ten komentarz został zminimalizowany przez moderatora na stronie
Mam w skoroszycie ponad 100 arkuszy, co oznacza, że ​​będę musiał uruchomić VBA ponad 100 razy, co jest czasochłonne.  
Udało mi się podzielić skoroszyt na wiele arkuszy, a następnie mogę przekonwertować każdy arkusz na pojedynczy dokument PDF.
Rozwiązaniem, którego szukam, jest wysłanie każdego dokumentu PDF osobno, podczas gdy powyższy proces jest uruchomiony.
Niniejszym VBA, którego aktualnie używam:
Sub Zapisz jakopdf i wyślij1()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTaklubNie, I, xNum Jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xArrShetts jako wariant
Dim xPDFNameAdres jako ciąg
Dim xStr jako ciąg
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") 'Wprowadź nazwy arkuszy, które wyślesz jako pliki pdf w cudzysłowie i oddziel je przecinkami. Upewnij się, że w nazwie pliku nie ma znaków specjalnych, takich jak \/:"*<>|.

Dla I = 0 do UBound(xArrShetts)
On Error Resume Next
Ustaw xSht = Aplikacja.ActiveWorkbook.Worksheets(xArrShetts(I))
If xSht.Name <> xArrShetts(I) Wtedy
MsgBox "Nie znaleziono arkusza roboczego, zakończ operację:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Exit Sub
End If
Dalej


Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
'Sprawdź, czy plik już istnieje
xYesorNo = MsgBox("Jeśli w folderze docelowym istnieją pliki o tej samej nazwie, do nazwy pliku zostanie automatycznie dodany przyrostek w celu rozróżnienia duplikatów" & vbCrLf & vbCrLf & "Kliknij Tak, aby kontynuować, kliknij Nie, aby anulować", _
vbYesNo + vbQuestion, "Plik istnieje")
Jeśli xYesorNo <> vbYes to zakończ Sub
Dla I = 0 do UBound(xArrShetts)
Ustaw xSht = Aplikacja.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xLiczba = 1
Chociaż nie (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xLiczba = xLiczba + 1
zastosować
Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xStr, Jakość:=xlQualityStandard
Więcej

End If
xArrShetts(I) = xStr
Dalej

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.To = "Ctracklegal@ctrack.com"
.CC = „”
.Temat = "?????"
Dla I = 0 do UBound(xArrShetts)
On Error Resume Next
.Załączniki.Dodaj xArrShetts(I)
Dalej
Jeśli DisplayEmail = False, to
.Wysłać
Exit Sub
End If
Kończyć z


End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć @kryształ
To jest super – kluczową rzeczą, z którą się zmagam, jest nazwa pliku – chciałbym, aby nazwa pliku była pobierana z komórki w arkuszu, zamiast używać nazwy karty. Zmodyfikowałem już kod, aby automatycznie zapisywał się w określonym folderze, ale mam problemy z nazwą pliku.
Jakakolwiek pomoc, którą możesz zaoferować, proszę?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Tori, Jeśli chcesz nazwać plik PDF określoną wartością komórki, wypróbuj następujący kod. Po uruchomieniu kodu i wybraniu folderu do zapisania pliku pojawi się kolejne okno dialogowe, wybierz komórkę, której będziesz używać wartość jako nazwę pliku PDF, a następnie kliknij OK, aby zakończyć.
Sub Zapisz jakopdf i wyślij2()
'Aktualizowany przez Extendoffice 20210521
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng, xRgInser jako zakres
Dim xB jako Boolean
Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xB = Prawda
On Error Resume Next
Podczas gdy xB
Ustaw xRgInser = Nic
Set xRgInser = Application.InputBox("Wybierz komórkę, której użyjesz wartości do nazwania pliku PDF:", "Kutools for Excel", , , , , , 8)
Jeśli xRgInser jest niczym, wtedy
MsgBox "Nie wybrano komórki, zakończ operację!", vbInformation, "Kutools for Excel"
Exit Sub
End If
Jeśli xRgInser.Text = "" Wtedy
MsgBox "Wybrana komórka jest pusta, proszę wybrać ponownie!", vbInformation, "Kutools for Excel"
Więcej
xB = Fałsz
End If
zastosować

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

'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć, potrzebowałem czegoś podobnego, więc oto, co mam. Bierze bieżącą datę i tworzy nowy folder z nazwą daty w określonej lokalizacji. Umieszcza plik PDF w tej nowej lokalizacji, a następnie dołącza plik PDF do nowego e-maila. Działa jako uczta. Jestem dopiero początkujący, więc przepraszam, jeśli wygląda to na bałagan. :D
Pod PDF DO E-MAIL()
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xPath jako ciąg
Dim xOutMsg jako ciąg
Dim sFolderName jako ciąg, sFolder jako ciąg
Dim sFolderPath jako ciąg

Ustaw xSht = Aktywny arkusz
xFileDate = Format(Teraz, "dd-mm-rrrr")
sFolder = "C:" 'tutaj masz główny folder
sFolderName = "Week ending " + Format(Now, "dd-mm-rrrr") 'folder do utworzenia w głównym folderze o nazwie Week ending i bieżąca data
sFolderPath = "C:" & sFolderName 'folder główny ponownie, aby utworzyć nową ścieżkę zawierającą nowy folder
Set ofFSO = CreateObject("Scripting.FileSystemObject")
Jeśli oFSO.FolderExists(sFolderPath) Wtedy
MsgBox "Folder już istnieje!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Więcej
MkDir sFolderPath
MsgBox "Utworzono nowy folder !" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xŚcieżka = sŚcieżkaFolderu
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Proszę znaleźć w załączniku Ten e-mail i załącznik zostały wygenerowane automatycznie ”
'dodaje uwagę, że wiadomość e-mail została wygenerowana automatycznie

Z xEmailObj
.Pokaz
.To = "" 'dodaj własne e-maile
.CC = „”
.Subject = xSht.Name + „PDF dla tygodnia kończącego się” + xFileDate + „-Lokalizacja” ' temat zawiera nazwę arkusza, pdf, datę i lokalizację, można to edytować w razie potrzeby
.Załączniki.Dodaj xFolder
.HTMLBody = xOutMsg i .HTMLBody
Jeśli DisplayEmail = False, to
'.Send <--- Tutaj, jeśli usuniesz apostrof, wiadomość e-mail zostanie wysłana automatycznie, więc zachowaj ostrożność
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Jak edytować ten kod, aby zapisać tylko komórki („a1:r99”) do zapisania jako plik PDF. Mam dodatkowe rzeczy po bokach, których nie chcę w moim dokumencie PDF.
Sub Zapisz jako PDF i wyślij()
'Aktualizowany przez Extendoffice 20210209
Dim xSht jako arkusz
Dim xFileDlg jako okno pliku
Dim xFolder jako ciąg
Dim xTak lub Nie jako liczba całkowita
Dim xOutlookObj jako obiekt
Dim xEmailObj jako obiekt
Dim xUsedRng jako zakres
Dim xStrName jako ciąg
Dim xV jako wariant

Ustaw xSht = Aktywny arkusz
Ustaw xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Jeśli xFileDlg.Show = True Wtedy
xFolder = xFileDlg.SelectedItems(1)
Więcej
MsgBox "Musisz określić folder, w którym chcesz zapisać plik PDF." & vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Należy określić folder docelowy"
Exit Sub
End If
xStrName = ""
xV = Application.InputBox("Wprowadź nazwę pliku:", "Kutools for Excel", , , , , , 2)
Jeśli xV = Fałsz Wtedy
Exit Sub
End If
xStrNazwa = xV
Jeśli xStrName = "" Wtedy
MsgBox ("Nie wprowadzono nazwy pliku, kończę proces!")
Exit Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Sprawdź, czy plik już istnieje
Jeśli Len(Dir(xFolder)) > 0 Wtedy
xYesorNo = MsgBox(xFolder & " już istnieje." & vbCrLf & vbCrLf & "Czy chcesz to nadpisać?", _
vbYesNo + vbQuestion, "Plik istnieje")
On Error Resume Next
Jeśli xTaklubNie = vbTak Wtedy
Zabij xFolder
Więcej
MsgBox "jeśli nie zastąpisz istniejącego pliku PDF, nie mogę kontynuować." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Wychodzenie z makra"
Exit Sub
End If
Jeśli Err.Number <> 0 Wtedy
MsgBox "Nie można usunąć istniejącego pliku. Upewnij się, że plik nie jest otwarty lub chroniony przed zapisem." _
& vbCrLf & vbCrLf & "Naciśnij OK, aby wyjść z tego makra.", vbCritical, "Nie można usunąć pliku"
Exit Sub
End If
End If

Ustaw xUsedRng = xSht.UsedRange
Jeśli Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Wtedy
„Zapisz jako plik PDF”
xSht.ExportAsFixedFormat Typ:=xlTypePDF, Nazwa pliku:=xFolder, Jakość:=xlQualityStandard

'Utwórz e-mail programu Outlook
Ustaw xOutlookObj = CreateObject("Outlook.Application")
Ustaw xEmailObj = xOutlookObj.CreateItem(0)
Z xEmailObj
.Pokaz
.Do = ""
.CC = „”
.Temat = xSht.Nazwa + ".pdf"
.Załączniki.Dodaj xFolder
Jeśli DisplayEmail = False, to
'.Wysłać
End If
Kończyć z
Więcej
MsgBox "Aktywny arkusz nie może być pusty"
Exit Sub
End If
End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Witam, właśnie wypróbowałem ten kod w jednym z moich arkuszy roboczych i mam ustawione obszary drukowania, więc dodatkowe rzeczy na dole nie pojawiły się w pliku PDF. Spróbuj!
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi
Wielkie dzięki za kod, ale czy możliwe jest automatyczne zapisanie pliku PDF w tej samej lokalizacji, co aktywny plik Excel i pod tą samą nazwą pliku, co aktywny plik Excel?
Wielkie dzięki.
Pręt
Nie ma tu jeszcze żadnych komentarzy
Pokaż więcej
Zostaw swój komentarz
Publikowanie jako gość
×
Oceń ten post:
0   Postacie
Sugerowane lokalizacje

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL