Note: The other languages of the website are Google-translated. Back to English
Σύνδεση Εγγραφή

Πώς να αποθηκεύσετε ένα φύλλο εργασίας ως αρχείο PDF και να το στείλετε μέσω ηλεκτρονικού ταχυδρομείου ως συνημμένο μέσω του Outlook;

Σε ορισμένες περιπτώσεις, ίσως χρειαστεί να στείλετε ένα φύλλο εργασίας ως αρχείο PDF μέσω του Outlook. Συνήθως, πρέπει να αποθηκεύσετε με μη αυτόματο τρόπο το φύλλο εργασίας ως αρχείο PDF και, στη συνέχεια, να δημιουργήσετε ένα νέο μήνυμα ηλεκτρονικού ταχυδρομείου με αυτό το αρχείο PDF ως συνημμένο στο Outlook και τελικά να το στείλετε. Είναι χρονοβόρο για την επίτευξή του χειροκίνητα βήμα προς βήμα. Σε αυτό το άρθρο, θα σας δείξουμε πώς να αποθηκεύσετε γρήγορα ένα φύλλο εργασίας ως αρχείο PDF και να το στείλετε αυτόματα ως συνημμένο μέσω του Outlook στο Excel.

Αποθηκεύστε ένα φύλλο εργασίας ως αρχείο PDF και στείλτε το μέσω ηλεκτρονικού ταχυδρομείου ως συνημμένο με κώδικα VBA

Αποθηκεύστε ένα φύλλο εργασίας ως αρχείο PDF και στείλτε το μέσω ηλεκτρονικού ταχυδρομείου ως συνημμένο με κώδικα VBA

Μπορείτε να εκτελέσετε τον παρακάτω κώδικα VBA για να αποθηκεύσετε αυτόματα το ενεργό φύλλο εργασίας ως αρχείο PDF και, στη συνέχεια, να το στείλετε μέσω ηλεκτρονικού ταχυδρομείου ως συνημμένο μέσω του Outlook. Κάντε τα εξής:

1. Ανοίξτε το φύλλο εργασίας που θα αποθηκεύσετε ως PDF και θα στείλετε και, στη συνέχεια, πατήστε το άλλος + F11 ταυτόχρονα για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Στο Microsoft Visual Basic για εφαρμογές παράθυρο, κάντε κλικ στην επιλογή Κύριο θέμα > Μονάδα μέτρησης. Στη συνέχεια, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα VBA στο Κώδικας παράθυρο. Δείτε το στιγμιότυπο οθόνης:

Κωδικός VBA: Αποθηκεύστε ένα φύλλο εργασίας ως αρχείο PDF και στείλτε το ως συνημμένο

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

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

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

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

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

3. Πάτα το F5 κλειδί για την εκτέλεση του κώδικα. Στο Αναζήτηση πλαίσιο διαλόγου, επιλέξτε έναν φάκελο για να αποθηκεύσετε αυτό το αρχείο PDF και, στη συνέχεια, κάντε κλικ στο OK κουμπί.

Notes:

1. Τώρα το ενεργό φύλλο εργασίας αποθηκεύεται ως αρχείο PDF. Και το αρχείο PDF ονομάζεται με το όνομα του φύλλου εργασίας.
2. Εάν το ενεργό φύλλο εργασίας είναι κενό, θα εμφανιστεί ένα πλαίσιο διαλόγου, όπως φαίνεται παρακάτω, αφού κάνετε κλικ στο OK κουμπί.

4. Τώρα δημιουργείται ένα νέο email του Outlook και μπορείτε να δείτε το αρχείο PDF να εμφανίζεται ως συνημμένο στο συνημμένο αρχείο. Δείτε το στιγμιότυπο οθόνης:

5. Συνθέστε αυτό το email και μετά στείλτε το.
6. Αυτός ο κωδικός είναι διαθέσιμος μόνο όταν χρησιμοποιείτε το Outlook ως πρόγραμμα αλληλογραφίας.

Αποθηκεύστε εύκολα ένα φύλλο εργασίας ή πολλά φύλλα εργασίας ως ξεχωριστά αρχεία PDF ταυτόχρονα:

Η καλύτερη Διαχωρισμός βιβλίου εργασίας χρησιμότητα του Kutools για Excel μπορεί να σας βοηθήσει να αποθηκεύσετε εύκολα ένα φύλλο εργασίας ή πολλά φύλλα εργασίας ως ξεχωριστά αρχεία PDF ταυτόχρονα με την παρακάτω επίδειξη. Κατεβάστε και δοκιμάστε το τώρα! (30-Ημέρα δωρεάν διαδρομή)

Σχετικά Άρθρα:

Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2021 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (63)
Βαθμολογήθηκε το 5 από το 5 · αξιολογήσεις 1
Μιχαήλ
Μιχαήλ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό λειτουργεί εξαιρετικά για μένα, αλλά υπάρχει τρόπος να επιλέξετε μια θέση φακέλου αυτόματα αντί να την επιλέξετε με μη αυτόματο τρόπο; Ελπίζω να το κάνω για 40 φύλλα ταυτόχρονα.
απάντηση
0
0
Hugh
Hugh     Μιχαήλ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ελπίζω επίσης να δω μια απάντηση για αυτό το θέμα! Ευχαριστώ για τη βοήθεια!
απάντηση
0
0
Ντάρεν
Ντάρεν
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δοκίμασα να το επικολλήσω σε μια νέα λειτουργική μονάδα και λαμβάνω το σφάλμα Compile: Sub ή Function not defined. Παρακαλώ βοηθήστε.
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Ντάρεν
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Darren,
Ποια έκδοση του Office χρησιμοποιείτε;
απάντηση
Αναφορά
0
0
Νάκια
Νάκια     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γραφείο 360
απάντηση
0
0
Νομοσχέδιο
Νομοσχέδιο     Ντάρεν
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το ίδιο ζήτημα
απάντηση
0
0
Μάικλ Τσάρι
Μάικλ Τσάρι
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς θα επεξεργαζόμουν το παραπάνω σενάριο VBA, ώστε να προσθέτει μια σήμανση ημερομηνίας και ώρας στο όνομα του αρχείου, έτσι ώστε να μην συνεχίσει να αντικαθιστά ό,τι είναι ήδη αποθηκευμένο;
απάντηση
Αναφορά
0
0
κρύσταλλο
κρύσταλλο     Μάικλ Τσάρι
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Μιχάλη,
Εκτελέστε τον παρακάτω κώδικα VBA για να λύσετε το πρόβλημα.

Sub Saveaspdfandsend()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xStr ως συμβολοσειρά

Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xStr = Μορφή(Τώρα(), "εεεε-μμ-ηη-ωω-μμ-δδ")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Παράγκ Σομάνη
Παράγκ Σομάνη     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Crystal,

Είναι πραγματικά υπέροχο και λειτουργεί τέλεια για μένα. Χρειάζεστε περισσότερη βοήθεια για να προσθέσετε:

1. στο "Προς" θέλω να δώσω σύνδεσμο σε συγκεκριμένο κελί του Ενεργού φύλλου όπως wise στο CC και στο BCC θα ήθελα να προσθέσω σύνδεσμο ενεργού φύλλου
2. στο σώμα του e-mail πρέπει να προσδιορίσω κάποιο τυπικό κείμενο.

Θα είμαι πολύ γεμάτος μαζί σας για τη βοήθειά σας.

Ευχαριστώ
Παρα
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Παράγκ Σομάνη
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Parag Somani,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει. Αλλάξτε τα πεδία .To, .CC, .BCC και .Body με βάση τις ανάγκες σας.

Sub Saveaspdfandsend()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xStr ως συμβολοσειρά

Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xStr = Μορφή(Τώρα(), "εεεε-μμ-ηη-ωω-μμ-δδ")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = Εύρος ("A8")
.CC = Εύρος ("A9")
.BCC = Εύρος ("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
.Σώμα = "Αγαπητέ" _
& vbNewLine & vbNewLine & _
"Αυτό είναι ένα δοκιμαστικό email" & _
"αποστολή στο Excel"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Mehul
Mehul     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Προσπαθώ να χρησιμοποιήσω το εύρος για "Προς", "CC", απλώς δεν λαμβάνει τις τιμές από το καθορισμένο κελί. Μπορείτε να βοηθήσετε σε αυτό;
Ευχαριστώ,
Mehul
απάντηση
0
0
Παράγκ Σομάνη
Παράγκ Σομάνη     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Crystal,

Είναι πραγματικά υπέροχο και λειτουργεί τέλεια για μένα. Χρειάζεστε περισσότερη βοήθεια για να προσθέσετε:

1. στο "Προς" θέλω να δώσω σύνδεσμο σε συγκεκριμένο κελί του Ενεργού φύλλου όπως wise στο CC και στο BCC θα ήθελα να προσθέσω σύνδεσμο ενεργού φύλλου
2. στο σώμα του e-mail πρέπει να προσδιορίσω κάποιο τυπικό κείμενο.

Θα είμαι πολύ γεμάτος μαζί σας για τη βοήθειά σας.

Ευχαριστώ
Παρα
απάντηση
0
0
Παρα
Παρα     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Crystal,

Είναι πραγματικά υπέροχο και λειτουργεί τέλεια για μένα. Χρειάζεστε περισσότερη βοήθεια για να προσθέσετε:

1. στο "Προς" θέλω να δώσω σύνδεσμο σε συγκεκριμένο κελί του Ενεργού φύλλου όπως wise στο CC και στο BCC θα ήθελα να προσθέσω σύνδεσμο ενεργού φύλλου
2. στο σώμα του e-mail πρέπει να προσδιορίσω κάποιο τυπικό κείμενο.

Θα είμαι πολύ γεμάτος μαζί σας για τη βοήθειά σας.

Ευχαριστώ
Παρα
απάντηση
Αναφορά
0
0
Armin
Armin
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορώ να προσθέσω για παράδειγμα το φύλλο 2 από το βιβλίο εργασίας ως pdf;
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Armin
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Αρμιν,
Πρέπει πρώτα να ανοίξετε το Φύλλο 2 στο βιβλίο εργασίας σας και στη συνέχεια να εκτελέσετε τον κώδικα VBA με τα παραπάνω βήματα για να τον κατεβάσετε.
απάντηση
Αναφορά
0
0
Τομ Χ
Τομ Χ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς θα επεξεργαζόμουν την παραπάνω δέσμη ενεργειών VBA, ώστε το όνομα του αρχείου να αποθηκευτεί ως ένα συγκεκριμένο κελί που έχει επιλεγεί στο τρέχον φύλλο, για παράδειγμα το κελί A1;
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Τομ Χ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Τομ.
Συγγνώμη δεν μπορώ να βοηθήσω με αυτό.
Καλώς ήρθατε να δημοσιεύσετε οποιαδήποτε ερώτηση στο φόρουμ μας: https://www.extendoffice.com/forum.html
Θα λάβετε περισσότερη υποστήριξη Excel από επαγγελματίες του Excel ή άλλους οπαδούς του Excel.
απάντηση
Αναφορά
0
0
james
james
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, πώς μπορώ να αποθηκεύσω και να στείλω το pdf με το όνομα του βιβλίου εργασίας με τον τρέχοντα κωδικό VBA; τι χρησιμοποιώ αντί για xSht.Name
απάντηση
0
0
κρύσταλλο
κρύσταλλο     james
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi James,
Θέλετε να στείλετε το ενεργό φύλλο εργασίας ως pdf και να το ονομάσετε ως όνομα βιβλίου εργασίας;
απάντηση
Αναφορά
0
0
ranga
ranga
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ λειτουργεί.
απάντηση
0
0
Ιάσονας
Ιάσονας
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορώ να το κάνω να διαγράψει το αποθηκευμένο pdf αφού του στείλει email;
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Ιάσονας
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια Jason,
Λυπάμαι, δεν μπορώ να σας βοηθήσω ακόμα σε αυτό. Πρέπει να το διαγράψετε με μη αυτόματο τρόπο αφού το στείλετε μέσω email.
απάντηση
Αναφορά
0
0
Οντ-Ίνγκε
Οντ-Ίνγκε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χαίρετε Κ.

Είναι δυνατόν να βρω το όνομα για pdf από ένα κελί; Πρώην. Κύτταρο H4


Και στο κελί H4 θέλω να συλλέγεται από τρία διαφορετικά κελιά. Είναι δυνατόν;
απάντηση
0
0
Taylor
Taylor     Οντ-Ίνγκε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό είναι πιθανό. Δημιουργήστε ξεχωριστές μεταβλητές για να κρατήσετε την τιμή από τα κελιά και, στη συνέχεια, χρησιμοποιήστε αυτές τις μεταβλητές όταν ορίζετε το xFolder.
Χρησιμοποίησα την τιμή από ένα κελί στο φύλλο μου συν τη σημερινή ημερομηνία. Ωστόσο, θα μπορούσατε εύκολα να κάνετε πολλές τιμές κελιών.

Αυτό πρόσθεσα:
Dim xMemberName ως συμβολοσειρά
Dim xFileDate ως συμβολοσειρά

xMemberName = Εύρος ("H3").Τιμή
xFileDate = Μορφή (Τώρα, "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
απάντηση
0
0
Sora
Sora     Taylor
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λαμβάνω ένα σφάλμα όταν το δοκιμάζω, πού στον κώδικα πρέπει να το τοποθετήσω;
απάντηση
0
0
Kishore
Kishore
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Crystal,



Είναι πραγματικά υπέροχο και λειτουργεί τέλεια για μένα. Χρειάζεστε περισσότερη βοήθεια για να προσθέσετε:

1. στο "Σώμα" θέλω να δώσω σύνδεσμο σε συγκεκριμένο κελί του Ενεργού φύλλου. Περαιτέρω Θα ήθελα να γίνει Bold το κείμενο.

Ευχαριστώ

Χαιρετισμούς

Kishore Kumar
απάντηση
Αναφορά
0
0
κρύσταλλο
κρύσταλλο     Kishore
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,

Εννοείτε να προσθέσετε αυτόματα την τιμή του κελιού στο σώμα του ταχυδρομείου και να το κάνετε έντονη γραφή; Ας υποθέσουμε ότι προσθέτετε την τιμή του C4 στο σώμα της αλληλογραφίας. Εφαρμόστε τον παρακάτω κωδικό.

Sub Saveaspdfandsend()

Dim xSht ως φύλλο εργασίας

Dim xFileDlg ως FileDialog

Dim xFolder ως συμβολοσειρά

Dim xYesorNo ως ακέραιος αριθμός

Dim xOutlookObj ως αντικείμενο

Dim xEmailObj ως αντικείμενο

Dim xUsedRng ως εύρος



Ορισμός xSht = ActiveSheet

Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)



Αν xFileDlg.Show = True Τότε

xFolder = xFileDlg.SelectedItems(1)

Αλλού

MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"

Έξοδος Sub

End If

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



'Ελέγξτε αν υπάρχει ήδη αρχείο

Αν Len(Dir(xFolder)) > 0 Τότε

xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _

vbYesNo + vbQuestion, "Το αρχείο υπάρχει")

On Error Συνέχιση Επόμενη

Αν xYesorNo = vbYes Τότε

Σκοτώστε το xFolder

Αλλού

MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _

& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"

Έξοδος Sub

End If

Αν Σφάλμα.Αριθμός <> 0 Τότε

MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _

& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"

Έξοδος Sub

End If

End If



Ορίστε xUsedRng = xSht.UsedRange

Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε

«Αποθήκευση ως αρχείο PDF

xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard



«Δημιουργία email του Outlook

Ορισμός xOutlookObj = CreateObject("Outlook.Application")

Ορισμός xEmailObj = xOutlookObj.CreateItem(0)

Με xEmailObj

.Απεικόνιση

.To = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

.Συνημμένα.Προσθήκη xFolder

.HTMLBody = "
" & Εύρος ("C4") & .HTMLBody

Αν DisplayEmail = False Τότε

'.Στείλετε

End If

Τέλος με

Αλλού

MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"

Έξοδος Sub

End If

Sub End
απάντηση
Αναφορά
0
0
Geoff
Geoff
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αν ήθελα να αποθηκεύεται αυτόματα σε έναν συγκεκριμένο φάκελο κάθε φορά (εξαλείφοντας την ανάγκη επιλογής του φακέλου από τον χρήστη), πώς θα το έκανα;
Πρώην. Γ: Τιμολόγια/Βόρεια Αμερική/Πελάτες
Βοήθεια είναι ευγνώμονες.
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Geoff
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια Geoff,
Εννοείτε να αποθηκεύσετε το φύλλο εργασίας ως αρχείο pdf και να το αποθηκεύσετε σε συγκεκριμένο φάκελο χωρίς αποστολή;
απάντηση
Αναφορά
0
0
Jeremy
Jeremy     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Νομίζω ότι ο Geoff σημαίνει να μπορείς να καθορίσεις έναν συγκεκριμένο φάκελο στον κώδικα στον οποίο αποθηκεύεται το pdf κάθε φορά αντί να χρειάζεται να επιλέξεις τη θέση με μη αυτόματο τρόπο. Στη συνέχεια, το pdf αποστέλλεται μέσω email από τον συγκεκριμένο φάκελο.
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Jeremy
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ Jeremy.
απάντηση
Αναφορά
0
0
κρύσταλλο
κρύσταλλο     Geoff
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Geoff, Εάν θέλετε να αποθηκεύσετε αυτόματα το αρχείο pdf σε έναν συγκεκριμένο φάκελο αντί να επιλέξετε την τοποθεσία με μη αυτόματο τρόπο, δοκιμάστε τον παρακάτω κώδικα. Μην ξεχάσετε να αλλάξετε τη διαδρομή φακέλου στον κώδικα.
Sub SaveAsPDFandSend()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xPath ως συμβολοσειρά
Ορισμός xSht = ActiveSheet
xPath = "C:\Users\Win10x64Test\Desktop\sheet σε pdf" "εδώ "φύλλο εργασίας σε pdf" είναι ο φάκελος προορισμού για την αποθήκευση των αρχείων pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Alison
Alison
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτός ο κώδικας λειτουργεί άψογα εκτός από το ότι θέλω να αποθηκευτεί το φύλλο εργασίας ως όνομα φύλλου + ημερομηνία (δηλ. Φύλλο 1 Οκτ. 1 2020). στην επιφάνεια εργασίας του χρήστη (αυτό θα χρησιμοποιηθεί από πολλά άτομα και οι διαδρομές τους ενδέχεται να διαφέρουν ελαφρώς). Εάν είναι δυνατόν, θέλω να ενσωματώσω ένα .jpg στο σώμα επίσης.. το JPG βρίσκεται τόσο μέσα στο φύλλο εργασίας (εκτός της περιοχής εκτύπωσης) όσο και η εικόνα αποθηκεύεται σε έναν κοινόχρηστο διακομιστή.. αν και η διαδρομή προς τον διακομιστή ποικίλλει ανάλογα με χρήστης (για τους περισσότερους είναι μονάδα δίσκου "T" για κάποιους "U")
μπορεί να γίνει αυτό; παρακαλώ και ευχαριστώ εκατομμύριο φορές.
απάντηση
0
0
Deepak
Deepak
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου

Γεια σας, λειτουργεί άψογα, σας ευχαριστούμε που το μοιραστήκατε. Χρειάζομαι μόνο μία βοήθεια.
Εάν θέλω να αποθηκεύσω ένα αρχείο PDF με προσαρμοσμένο όνομα (επιλογή πληκτρολόγησης ονόματος αρχείου στο πλαίσιο διαλόγου SaveAs), καθώς ο χρήστης χρησιμοποιεί αυτήν την επιλογή στο πρότυπο φόρμας όπου οι φόρμες αποθηκεύονται ως PDF με μοναδικό όνομα .
απάντηση
Αναφορά
0
0
κρύσταλλο
κρύσταλλο     Deepak
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, δοκιμάστε τον παρακάτω κώδικα VBA. Αφού εκτελέσετε τον κώδικα, επιλέξτε έναν φάκελο για να αποθηκεύσετε το αρχείο PDF και, στη συνέχεια, θα εμφανιστεί ένα παράθυρο διαλόγου για να εισαγάγετε το όνομα του αρχείου. Sub Saveaspdfandsend()
«Ενημερώθηκε από Extendoffice 20210209
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xStrName ως συμβολοσειρά
Dim xV As Variant

Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xStrName = ""
xV = Application.InputBox("Εισαγάγετε το όνομα αρχείου:", "Kutools for Excel", , , , , , 2)
Αν xV = Λάθος Τότε
Έξοδος Sub
End If
xStrName = xV
Αν xStrName = "" Τότε
MsgBox ("Δεν έχει εισαχθεί όνομα αρχείου, διαδικασία εξόδου!")
Έξοδος Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
mleczus94
mleczus94
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Εάν έχω δύο φύλλα στο αρχείο και θα ήθελα να εκτελέσω αυτήν τη μακροεντολή σε ένα φύλλο (πατώντας κουμπί) αλλά να στείλω ένα άλλο, πώς μπορώ να το λάβω;
απάντηση
Αναφορά
0
0
ε
ε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, θα ήθελα να το αποθηκεύσω σε μια συγκεκριμένη τοποθεσία αρχείου, με το όνομα να βασίζεται στην τιμή στο κελί C30. Έχω δοκιμάσει μερικές επιλογές, αλλά συνεχίζω να λαμβάνω σφάλματα.
απάντηση
0
0
κρύσταλλο
κρύσταλλο     ε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου, ο παρακάτω κώδικας μπορεί να βοηθήσει. Αφού εκτελέσετε τον κώδικα, επιλέξτε έναν συγκεκριμένο φάκελο για να αποθηκεύσετε το αρχείο PDF και, στη συνέχεια, θα εμφανιστεί ένα παράθυρο διαλόγου για να εισαγάγετε το όνομα του αρχείου. Sub Saveaspdfandsend()
«Ενημερώθηκε από Extendoffice 20210209
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xStrName ως συμβολοσειρά
Dim xV As Variant

Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xStrName = ""
xV = Application.InputBox("Εισαγάγετε το όνομα αρχείου:", "Kutools for Excel", , , , , , 2)
Αν xV = Λάθος Τότε
Έξοδος Sub
End If
xStrName = xV
Αν xStrName = "" Τότε
MsgBox ("Δεν έχει εισαχθεί όνομα αρχείου, διαδικασία εξόδου!")
Έξοδος Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Hein
Hein     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για αυτό, είναι υπέροχο, αλλά θέλω το φύλλο να ονομαστεί σύμφωνα με το κελί A1 στο φύλλο 1. το μέρος για αποθήκευση σύμφωνα με το A1 στο φύλλο 2, για παράδειγμα C:\Users\peete\Dropbox\Screenshots και αποστολή email στο διεύθυνση email στο φύλλο Α3 2 αυτό που έχω ήδη επεξεργαστεί.
απάντηση
0
0
HeinPeeters
HeinPeeters     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για αυτό, είναι υπέροχο, αλλά θέλω το φύλλο να ονομαστεί σύμφωνα με το κελί A1 στο φύλλο 1. το μέρος για αποθήκευση σύμφωνα με το A1 στο φύλλο 2, για παράδειγμα C:\Users\peete\Dropbox\Screenshots, αλλά μπορεί να αλλάξει όταν χρησιμοποιώντας το αρχείο και στείλτε email στη διεύθυνση email στο φύλλο Α3 2 αυτό που έχω ήδη επεξεργαστεί.
απάντηση
Αναφορά
0
0
BenSpo
BenSpo
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi κρύσταλλο , εξαιρετικός κώδικας, ευχαριστώ για την κοινή χρήση. Υπάρχει τρόπος να επιλέξετε πολλαπλά φύλλα (από το ίδιο βιβλίο εργασίας) για να αποθηκεύσετε το καθένα ως ανεξάρτητο PDF και στη συνέχεια να τα στείλετε όλα συνημμένα σε ένα email;
απάντηση
Αναφορά
0
0
κρύσταλλο
κρύσταλλο     BenSpo
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, ο παρακάτω κώδικας VBA μπορεί να σας κάνει τη χάρη, δοκιμάστε. Στη δωδέκατη γραμμή του κώδικα, αντικαταστήστε τα ονόματα των φύλλων με τα πραγματικά ονόματα φύλλων στην περίπτωσή σας.
Sub Saveaspdfandsend1()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xArrShetts As Variant
Dim xPDFNameAddress ως συμβολοσειρά
Dim xStr ως συμβολοσειρά
xArrShetts = Πίνακας("δοκιμή", "Φύλλο 1", "Φύλλο 2") «Πληκτρολογήστε τα ονόματα των φύλλων που θα στείλετε ως αρχεία pdf που εσωκλείονται με εισαγωγικά και διαχωρίστε τα με κόμμα. Βεβαιωθείτε ότι δεν υπάρχουν ειδικοί χαρακτήρες όπως \/:"*<>| στο όνομα του αρχείου.

Για I = 0 σε UBound (xArrShetts)
On Error Συνέχιση Επόμενη
Ορισμός xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Αν xSht.Όνομα <> xArrShetts(I) Τότε
MsgBox "Δεν βρέθηκε φύλλο εργασίας, έξοδος από τη λειτουργία:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Έξοδος Sub
End If
Επόμενο


Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
'Ελέγξτε αν υπάρχει ήδη αρχείο
xYesorNo = MsgBox("Εάν υπάρχουν αρχεία με το ίδιο όνομα στον φάκελο προορισμού, το επίθημα αριθμού θα προστεθεί αυτόματα στο όνομα του αρχείου για να διακρίνονται τα διπλότυπα" & vbCrLf & vbCrLf & "Κάντε κλικ Ναι για να συνεχίσετε, κάντε κλικ στο Όχι για ακύρωση", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
Αν xYesorNo <> vbYes Τότε βγείτε από το Sub
Για I = 0 σε UBound (xArrShetts)
Ορισμός xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Ενώ όχι (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Διευθύνω
Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xStr, Ποιότητα:=xlQualityStandard
Αλλού

End If
xArrShetts(I) = xStr
Επόμενο

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Θέμα = "????"
Για I = 0 σε UBound (xArrShetts)
.Συνημμένα.Προσθήκη xArrShetts(I)
Επόμενο
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Sub End
απάντηση
Αναφορά
0
0
Berneé Rudolph
Berneé Rudolph     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, η μόνη αλλαγή με την οποία δυσκολεύομαι είναι να δημιουργήσω ένα ξεχωριστό email για κάθε έγγραφο pdf που δημιουργείται.
απάντηση
0
0
κρύσταλλο
κρύσταλλο     Berneé Rudolph
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, Για να δημιουργήσετε ένα ξεχωριστό email για κάθε έγγραφο pdf, μπορείτε να εκτελέσετε μη αυτόματα το VBA που παρέχεται στην ανάρτηση σε διαφορετικά φύλλα εργασίας για να το ολοκληρώσετε.
απάντηση
Αναφορά
0
0
Berneé Rudolph
Berneé Rudolph     κρύσταλλο
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω περισσότερα από 100 φύλλα εργασίας στο βιβλίο εργασίας, πράγμα που σημαίνει ότι πρέπει να εκτελέσω το VBA περισσότερες από 100 φορές, κάτι που είναι χρονοβόρο.  
Κατάφερα να χωρίσω το βιβλίο εργασίας μου στο πολλαπλό φύλλο και, στη συνέχεια, μπορώ να μετατρέψω κάθε φύλλο εργασίας σε ένα μεμονωμένο έγγραφο PDF.
Η λύση που ψάχνω είναι να στείλω με email κάθε έγγραφο PDF ξεχωριστά όσο εκτελείται η παραπάνω διαδικασία.
Μαζί με το VBA που τρέχω αυτήν τη στιγμή:
Sub Saveaspdfandsend1()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo, I, xNum As Integer
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xArrShetts As Variant
Dim xPDFNameAddress ως συμβολοσειρά
Dim xStr ως συμβολοσειρά
xArrShetts = Πίνακας("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", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX"
"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", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX"
"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", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX"
"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", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX"
"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", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX", "XNUMX"
"02563445", "02563737", "02563828", "02563852", "02563861", "02563971", "02564042", _
"02564315", "02564366", "02564832", "02564909", "02565059", "02565205") 'Εισαγάγετε τα ονόματα των φύλλων που θα στείλετε ως αρχεία pdf που εσωκλείονται με εισαγωγικά και διαχωρίστε τα με κόμμα. Βεβαιωθείτε ότι δεν υπάρχουν ειδικοί χαρακτήρες όπως \/:"*<>| στο όνομα του αρχείου.

Για I = 0 σε UBound (xArrShetts)
On Error Συνέχιση Επόμενη
Ορισμός xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))
Αν xSht.Όνομα <> xArrShetts(I) Τότε
MsgBox "Δεν βρέθηκε φύλλο εργασίας, έξοδος από τη λειτουργία:" & vbCrLf & vbCrLf & xArrShetts(I), vbInformation, "Kutools for Excel"
Έξοδος Sub
End If
Επόμενο


Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
'Ελέγξτε αν υπάρχει ήδη αρχείο
xYesorNo = MsgBox("Εάν υπάρχουν αρχεία με το ίδιο όνομα στον φάκελο προορισμού, το επίθημα αριθμού θα προστεθεί αυτόματα στο όνομα του αρχείου για να διακρίνονται τα διπλότυπα" & vbCrLf & vbCrLf & "Κάντε κλικ Ναι για να συνεχίσετε, κάντε κλικ στο Όχι για ακύρωση", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
Αν xYesorNo <> vbYes Τότε βγείτε από το Sub
Για I = 0 σε UBound (xArrShetts)
Ορισμός xSht = Application.ActiveWorkbook.Worksheets(xArrShetts(I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
Ενώ όχι (Dir(xStr, vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
Διευθύνω
Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xStr, Ποιότητα:=xlQualityStandard
Αλλού

End If
xArrShetts(I) = xStr
Επόμενο

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = "Ctracklegal@ctrack.com"
.CC = ""
.Θέμα = "????"
Για I = 0 σε UBound (xArrShetts)
On Error Συνέχιση Επόμενη
.Συνημμένα.Προσθήκη xArrShetts(I)
Επόμενο
Αν DisplayEmail = False Τότε
.Στείλετε
Έξοδος Sub
End If
Τέλος με


Sub End
απάντηση
0
0
tori
tori
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια @crystal
Αυτό είναι υπέροχο - το βασικό πράγμα με το οποίο δυσκολεύομαι είναι το όνομα του αρχείου - θα ήθελα το όνομα του αρχείου να βγαίνει από ένα κελί στο φύλλο εργασίας αντί να χρησιμοποιείται το όνομα της καρτέλας. Έχω ήδη επεξεργαστεί τον κώδικα για αυτόματη αποθήκευση σε έναν καθορισμένο φάκελο, αλλά δυσκολεύομαι με το όνομα του αρχείου.
Οποιαδήποτε βοήθεια μπορείτε να προσφέρετε παρακαλώ;
απάντηση
0
0
κρύσταλλο
κρύσταλλο     tori
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια Tori, Εάν θέλετε να ονομάσετε το αρχείο PDF με μια συγκεκριμένη τιμή κελιού, δοκιμάστε τον ακόλουθο κώδικα. Αφού εκτελέσετε τον κώδικα και επιλέξετε έναν φάκελο για να αποθηκεύσετε το αρχείο, εμφανίζεται ένα άλλο παράθυρο διαλόγου, επιλέξτε το κελί που θα χρησιμοποιήσετε την τιμή ως το όνομα του αρχείου PDF και, στη συνέχεια, κάντε κλικ στο OK για να ολοκληρώσετε.
Sub Saveaspdfandsend2()
«Ενημερώθηκε από Extendoffice 20210521
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng, xRgInser As Range
Dim xB ως Boolean
Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xB = Σωστό
On Error Συνέχιση Επόμενη
Ενώ xB
Ορισμός xRgInser = Τίποτα
Set xRgInser = Application.InputBox("Επιλέξτε ένα κελί που θα χρησιμοποιήσετε την τιμή για να ονομάσετε το αρχείο PDF:", "Kutools for Excel", , , , , , 8)
Αν το xRgInser δεν είναι τίποτα τότε
MsgBox " Δεν έχει επιλεγεί κελί, βγείτε από τη λειτουργία! ", vbInformation, "Kutools for Excel"
Έξοδος Sub
End If
Αν xRgInser.Text = "" Τότε
MsgBox " Το επιλεγμένο κελί είναι κενό, επιλέξτε ξανά! ", vbInformation, "Kutools for Excel"
Αλλού
xB = Λάθος
End If
Διευθύνω

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

'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Makeeuropeanu
Makeeuropeanu
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, χρειαζόμουν κάτι παρόμοιο, οπότε ορίστε αυτό που πήρα. Λαμβάνει την τρέχουσα ημερομηνία και δημιουργεί έναν νέο φάκελο με το όνομα της ημερομηνίας σε μια συγκεκριμένη τοποθεσία. Τοποθετεί το pdf μέσα σε αυτήν τη νέα τοποθεσία και, στη συνέχεια, επισυνάπτει το pdf σε ένα νέο email. Λειτουργεί ως απόλαυση. Είμαι απλώς αρχάριος, οπότε παρακαλώ με συγχωρείτε αν φαίνεται σαν χάος. :ΡΕ
Υπο PDFTOEMAIL()
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xPath ως συμβολοσειρά
Dim xOutMsg ως συμβολοσειρά
Dim sFolderName As String, sFolder As String
Dim sFolderPath ως συμβολοσειρά

Ορισμός xSht = ActiveSheet
xFileDate = Μορφή (Τώρα, "ηη-μμ-εεεε")
sFolder = "C:" 'εδώ είναι όπου έχετε έναν κύριο φάκελο
sFolderName = "Λήξη εβδομάδας " + Μορφή(Τώρα, "ηη-μμ-εεεε") 'φάκελος που θα δημιουργηθεί στον κύριο φάκελο με όνομα Λήξη εβδομάδας και τρέχουσα ημερομηνία
sFolderPath = "C:" & sFolderName 'κύριος φάκελος ξανά για να δημιουργήσετε τη νέα διαδρομή συμπεριλαμβανομένου του νέου φακέλου
Σετ oFSO = CreateObject ("Scripting.FileSystemObject")
Αν oFSO.FolderExists(sFolderPath) Τότε
MsgBox "Ο φάκελος υπάρχει ήδη!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
Αλλού
MkDir sFolderPath
MsgBox "Δημιουργήθηκε νέος φάκελος!" & vbCrLf & vbCrLf & sFolderPath, vbInformation, "INFO"
End If
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
xOutMsg = " Βρείτε το συνημμένο Αυτό το email και το συνημμένο έχουν δημιουργηθεί αυτόματα "
Προσθέτει μια σημείωση ότι το email δημιουργήθηκε αυτόματα

Με xEmailObj
.Απεικόνιση
.To = "" 'προσθέστε τα δικά σας email
.CC = ""
.Subject = xSht.Name + " PDF για την εβδομάδα που λήγει " + xFileDate + " - Τοποθεσία " ' το θέμα περιλαμβάνει όνομα φύλλου, pdf, ημερομηνία και τοποθεσία, αυτό μπορεί να επεξεργαστεί όπως απαιτείται
.Συνημμένα.Προσθήκη xFolder
.HTMLBody = xOutMsg & .HTMLBody
Αν DisplayEmail = False Τότε
'.Στείλτε <--- Εδώ αν διαγράψετε την απόστροφη, το email θα σταλεί αυτόματα, γι' αυτό να είστε προσεκτικοί
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
Αναφορά
0
0
Nicole
Nicole
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Πώς μπορώ να επεξεργαστώ αυτόν τον κώδικα για αποθήκευση μόνο κελιών ("a1:r99") για αποθήκευση ως PDF. Έχω επιπλέον πράγματα στις πλευρές που δεν θέλω στο έγγραφο PDF μου.
Sub Saveaspdfandsend()
«Ενημερώθηκε από Extendoffice 20210209
Dim xSht ως φύλλο εργασίας
Dim xFileDlg ως FileDialog
Dim xFolder ως συμβολοσειρά
Dim xYesorNo ως ακέραιος αριθμός
Dim xOutlookObj ως αντικείμενο
Dim xEmailObj ως αντικείμενο
Dim xUsedRng ως εύρος
Dim xStrName ως συμβολοσειρά
Dim xV As Variant

Ορισμός xSht = ActiveSheet
Ορισμός xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

Αν xFileDlg.Show = True Τότε
xFolder = xFileDlg.SelectedItems(1)
Αλλού
MsgBox "Πρέπει να καθορίσετε έναν φάκελο στον οποίο θα αποθηκεύσετε το PDF." & vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Πρέπει να καθορίσετε τον φάκελο προορισμού"
Έξοδος Sub
End If
xStrName = ""
xV = Application.InputBox("Εισαγάγετε το όνομα αρχείου:", "Kutools for Excel", , , , , , 2)
Αν xV = Λάθος Τότε
Έξοδος Sub
End If
xStrName = xV
Αν xStrName = "" Τότε
MsgBox ("Δεν έχει εισαχθεί όνομα αρχείου, διαδικασία εξόδου!")
Έξοδος Sub
End If

xFolder = xFolder + "\" + xStrName + ".pdf"
'Ελέγξτε αν υπάρχει ήδη αρχείο
Αν Len(Dir(xFolder)) > 0 Τότε
xYesorNo = MsgBox(xFolder & " υπάρχει ήδη." & vbCrLf & vbCrLf & "Θέλετε να το αντικαταστήσετε;", _
vbYesNo + vbQuestion, "Το αρχείο υπάρχει")
On Error Συνέχιση Επόμενη
Αν xYesorNo = vbYes Τότε
Σκοτώστε το xFolder
Αλλού
MsgBox "αν δεν αντικαταστήσετε το υπάρχον PDF, δεν μπορώ να συνεχίσω." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Έξοδος μακροεντολής"
Έξοδος Sub
End If
Αν Σφάλμα.Αριθμός <> 0 Τότε
MsgBox "Δεν είναι δυνατή η διαγραφή του υπάρχοντος αρχείου. Βεβαιωθείτε ότι το αρχείο δεν είναι ανοιχτό ή προστατεύεται από εγγραφή." _
& vbCrLf & vbCrLf & "Πατήστε OK για έξοδο από αυτήν τη μακροεντολή.", vbCritical, "Δεν είναι δυνατή η διαγραφή αρχείου"
Έξοδος Sub
End If
End If

Ορίστε xUsedRng = xSht.UsedRange
Αν Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Τότε
«Αποθήκευση ως αρχείο PDF
xSht.ExportAsFixedFormat Τύπος:=xlTypePDF, Όνομα αρχείου:=xFolder, Ποιότητα:=xlQualityStandard

«Δημιουργία email του Outlook
Ορισμός xOutlookObj = CreateObject("Outlook.Application")
Ορισμός xEmailObj = xOutlookObj.CreateItem(0)
Με xEmailObj
.Απεικόνιση
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Συνημμένα.Προσθήκη xFolder
Αν DisplayEmail = False Τότε
'.Στείλετε
End If
Τέλος με
Αλλού
MsgBox "Το ενεργό φύλλο εργασίας δεν μπορεί να είναι κενό"
Έξοδος Sub
End If
Sub End
απάντηση
0
0
RLF
RLF     Nicole
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, μόλις δοκίμασα αυτόν τον κώδικα σε ένα από τα φύλλα εργασίας μου και έχω ορίσει τις περιοχές εκτύπωσης, ώστε τα επιπλέον στοιχεία στο κάτω μέρος να μην εμφανίζονται στο pdf. Δοκίμασέ το!
απάντηση
0
0
Ροντ Μπένετ
Ροντ Μπένετ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi
Ευχαριστώ πολύ για τον Κώδικα, αλλά είναι δυνατή η αυτόματη αποθήκευση του PDF στην ίδια θέση με το ενεργό αρχείο Excel και με το ίδιο όνομα αρχείου με το ενεργό αρχείο Excel;
Πολλές ευχαριστίες.
Ράβδος
απάντηση
0
0
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Επισκέπτης
Δημοσίευση ως επισκέπτης
Σύνδεση
×
Αξιολογήστε αυτήν την ανάρτηση:
Επαναφορά
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL