Εγκατέστησα τα kutools για να βοηθήσω με ένα έργο για εργασία. Διαχειρίζομαι επίσης μια έκθεση μεγάλης εταιρείας που έχει μια μακροεντολή που δημιουργεί ένα email από πληροφορίες που έχουν εισαχθεί. Αυτή η μακροεντολή σταμάτησε να λειτουργεί στον υπολογιστή μου. Λειτουργεί σε υπολογιστές που δεν διαθέτουν kutools. Έχει συναντήσει κανείς κάτι τέτοιο στο παρελθόν; Εδώ είναι η μακροεντολή που λειτουργεί μια χαρά σε άλλους υπολογιστές:
Sub Mail_Sheet_Outlook_Body()
«Εργασία στο Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng ως εύρος
Dim OutApp ως αντικείμενο
Dim OutMail ως αντικείμενο
Dim xFolder ως συμβολοσειρά
Dim xSht ως φύλλο εργασίας
Dim xSub ως συμβολοσειρά
Dim Response As String
Dim Msg As String
Dim Style As String
Dim Title As String
Ορισμός xSht = ActiveSheet
Msg = "Είστε βέβαιοι ότι θέλετε να στείλετε email σε αυτήν τη φόρμα;" Ορίστε το μήνυμα.
Στυλ = vbYesNo + vbCritical + vbDefaultButton2 ' Κουμπιά ορισμού.
Title = "Επιβεβαίωση αποστολής email" ' Ορίστε τον τίτλο.
Απάντηση = MsgBox(Msg, Style)
Αν Απάντηση = vbYes Τότε
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Τιμή) + "--.pdf"
'xSub = "Έλεγχος πεδίου για κατάστημα " + CStr(xSht.Cells(19, "A").Τιμή)
Με την εφαρμογή
.EnableEvents = False
.ScreenUpdating = False
Τέλος με
Ορισμός rng = Τίποτα
Ορισμός rng = ActiveSheet.UsedRange
«Μπορείτε επίσης να χρησιμοποιήσετε ένα όνομα φύλλου
'Set rng = Sheets("YourSheet").UsedRange
Ορισμός OutApp = CreateObject ("Outlook.Application")
Ορισμός OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long
On Error Συνέχιση Επόμενη
Με OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Ανακεφαλαίωση"
.Συνημμένα.Προσθήκη xFolder
.HTMLBody = RangetoHTML(rng)
.Εμφάνιση ή χρήση .Εμφάνιση
Τέλος με
Στο σφάλμα GoTo 0
Με την εφαρμογή
.EnableEvents = True
.ScreenUpdating = True
Τέλος με
Ορισμός OutMail = Τίποτα
Ρύθμιση OutApp = Τίποτα
End If
Sub End
Συνάρτηση RangetoHTML(rng As Range)
Εργασία στο Office 2000-2016
Dim fso ως αντικείμενο
Dim ts ως αντικείμενο
Dim TempFile As String
Dim TempWB As Book Work
TempFile = Environ$("temp") & "\" & Format(Τώρα, "ηη-μμ-εε ω-μμ-δδ") & ".htm"
«Αντιγράψτε το εύρος και δημιουργήστε ένα νέο βιβλίο εργασίας για να ξεπεράσετε τα δεδομένα
rng.Αντιγραφή
Ορισμός TempWB = Βιβλία εργασίας. Προσθήκη(1)
Με TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Κελιά(1).Επιλέξτε
Application.CutCopyMode = Λάθος
On Error Συνέχιση Επόμενη
.DrawingObjects.Visible = True
.DrawingObjects.Delete
Στο σφάλμα GoTo 0
Τέλος με
«Δημοσίευση του φύλλου σε αρχείο htm
Με TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Όνομα αρχείου:=TempFile, _
Φύλλο:=TempWB.Sheets(1).Όνομα, _
Πηγή:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Δημοσίευση (αληθές)
Τέλος με
«Διαβάστε όλα τα δεδομένα από το αρχείο htm στο RangetoHTML
Ορισμός fso = CreateObject ("Scripting.FileSystemObject")
Ορίστε ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Κλείσιμο
RangetoHTML = Αντικατάσταση(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
«Κλείστε το TempWB
TempWB.Close savechanges:=False
«Διαγράψτε το αρχείο htm που χρησιμοποιήσαμε σε αυτήν τη λειτουργία
Σκοτώστε το TempFile
Σετ ts = Τίποτα
Σετ fso = Τίποτα
Ορίστε TempWB = Τίποτα
Τέλος Λειτουργία
Sub Mail_Sheet_Outlook_Body()
«Εργασία στο Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng ως εύρος
Dim OutApp ως αντικείμενο
Dim OutMail ως αντικείμενο
Dim xFolder ως συμβολοσειρά
Dim xSht ως φύλλο εργασίας
Dim xSub ως συμβολοσειρά
Dim Response As String
Dim Msg As String
Dim Style As String
Dim Title As String
Ορισμός xSht = ActiveSheet
Msg = "Είστε βέβαιοι ότι θέλετε να στείλετε email σε αυτήν τη φόρμα;" Ορίστε το μήνυμα.
Στυλ = vbYesNo + vbCritical + vbDefaultButton2 ' Κουμπιά ορισμού.
Title = "Επιβεβαίωση αποστολής email" ' Ορίστε τον τίτλο.
Απάντηση = MsgBox(Msg, Style)
Αν Απάντηση = vbYes Τότε
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Τιμή) + "--.pdf"
'xSub = "Έλεγχος πεδίου για κατάστημα " + CStr(xSht.Cells(19, "A").Τιμή)
Με την εφαρμογή
.EnableEvents = False
.ScreenUpdating = False
Τέλος με
Ορισμός rng = Τίποτα
Ορισμός rng = ActiveSheet.UsedRange
«Μπορείτε επίσης να χρησιμοποιήσετε ένα όνομα φύλλου
'Set rng = Sheets("YourSheet").UsedRange
Ορισμός OutApp = CreateObject ("Outlook.Application")
Ορισμός OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long
On Error Συνέχιση Επόμενη
Με OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Ανακεφαλαίωση"
.Συνημμένα.Προσθήκη xFolder
.HTMLBody = RangetoHTML(rng)
.Εμφάνιση ή χρήση .Εμφάνιση
Τέλος με
Στο σφάλμα GoTo 0
Με την εφαρμογή
.EnableEvents = True
.ScreenUpdating = True
Τέλος με
Ορισμός OutMail = Τίποτα
Ρύθμιση OutApp = Τίποτα
End If
Sub End
Συνάρτηση RangetoHTML(rng As Range)
Εργασία στο Office 2000-2016
Dim fso ως αντικείμενο
Dim ts ως αντικείμενο
Dim TempFile As String
Dim TempWB As Book Work
TempFile = Environ$("temp") & "\" & Format(Τώρα, "ηη-μμ-εε ω-μμ-δδ") & ".htm"
«Αντιγράψτε το εύρος και δημιουργήστε ένα νέο βιβλίο εργασίας για να ξεπεράσετε τα δεδομένα
rng.Αντιγραφή
Ορισμός TempWB = Βιβλία εργασίας. Προσθήκη(1)
Με TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Κελιά(1).Επιλέξτε
Application.CutCopyMode = Λάθος
On Error Συνέχιση Επόμενη
.DrawingObjects.Visible = True
.DrawingObjects.Delete
Στο σφάλμα GoTo 0
Τέλος με
«Δημοσίευση του φύλλου σε αρχείο htm
Με TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Όνομα αρχείου:=TempFile, _
Φύλλο:=TempWB.Sheets(1).Όνομα, _
Πηγή:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Δημοσίευση (αληθές)
Τέλος με
«Διαβάστε όλα τα δεδομένα από το αρχείο htm στο RangetoHTML
Ορισμός fso = CreateObject ("Scripting.FileSystemObject")
Ορίστε ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Κλείσιμο
RangetoHTML = Αντικατάσταση(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
«Κλείστε το TempWB
TempWB.Close savechanges:=False
«Διαγράψτε το αρχείο htm που χρησιμοποιήσαμε σε αυτήν τη λειτουργία
Σκοτώστε το TempFile
Σετ ts = Τίποτα
Σετ fso = Τίποτα
Ορίστε TempWB = Τίποτα
Τέλος Λειτουργία