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

Πώς να στείλετε email εάν ένα συγκεκριμένο κελί έχει τροποποιηθεί στο Excel;

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

Στείλτε email εάν το κελί σε ένα συγκεκριμένο εύρος έχει τροποποιηθεί με κωδικό VBA


Στείλτε email εάν το κελί σε ένα συγκεκριμένο εύρος έχει τροποποιηθεί με κωδικό VBA

Εάν χρειάζεται να δημιουργήσετε ένα νέο email αυτόματα με το ενεργό βιβλίο εργασίας να είναι συνημμένο όταν ένα κελί στην περιοχή A2:E11 τροποποιείται σε ένα συγκεκριμένο φύλλο εργασίας, ο ακόλουθος κώδικας VBA μπορεί να σας βοηθήσει.

1. Στο φύλλο εργασίας που πρέπει να στείλετε email με βάση το τροποποιημένο κελί του σε ένα συγκεκριμένο εύρος, κάντε δεξί κλικ στην καρτέλα φύλλων και, στη συνέχεια, κάντε κλικ στο Προβολή κωδικού από το μενού περιβάλλοντος. Δείτε το στιγμιότυπο οθόνης:

2. Στο αναδυόμενο παράθυρο Microsoft Visual Basic για εφαρμογές παράθυρο, αντιγράψτε και επικολλήστε κάτω από τον κώδικα VBA στο παράθυρο Code.

Κωδικός VBA: Στείλτε email εάν το κελί σε ένα καθορισμένο εύρος έχει τροποποιηθεί στο Excel

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Notes:

1). Στον κώδικα, Α2: Ε11 είναι το εύρος στο οποίο θα στείλετε email βάσει.
2). Αλλάξτε το σώμα του email όπως χρειάζεστε xMailBody γραμμή στον κώδικα.
3). Αντικαταστήστε το Διεύθυνση ηλεκτρονικού ταχυδρομείου με τη διεύθυνση email του παραλήπτη στη γραμμή .To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου".
4). Αλλάξτε το θέμα του email στη σειρά .Subject = "Το φύλλο εργασίας τροποποιήθηκε στο" & ThisWorkbook.FullName.

3. Πάτα το άλλος + Q ταυτόχρονα για να κλείσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

Από τώρα και στο εξής, οποιοδήποτε κελί στην περιοχή A2: E11 τροποποιείται, θα δημιουργηθεί ένα νέο email με συνημμένο το ενημερωμένο βιβλίο εργασίας. Και όλα τα καθορισμένα πεδία όπως το θέμα, ο παραλήπτης και το σώμα email θα αναφέρονται στο email. Στείλτε το email.

Note: Ο κώδικας VBA λειτουργεί μόνο εάν χρησιμοποιείτε το Outlook ως πρόγραμμα email.


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


Τα καλύτερα εργαλεία παραγωγικότητας του 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% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (37)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχω κολλήσει κάτω από τον κώδικα VB. Προσπαθώ να λαμβάνω ειδοποίηση μέσω email στον χρήστη όπου έχουν αλλάξει τα δεδομένα. Το ηλεκτρονικό ταχυδρομείο λειτουργεί, αλλά όταν κάνω οποιαδήποτε αλλαγή, το μήνυμα ηλεκτρονικού ταχυδρομείου ξεκινά αμέσως, αλλά θέλω email όταν το φύλλο excel αποθηκεύεται και κλείνει μετά την πραγματοποίηση όλων των αλλαγών σε όλους τους χρήστες που επηρεάστηκαν. Επίσης, αυτό θα πρέπει να λειτουργεί για οποιοδήποτε από τα φύλλα ολόκληρου του βιβλίου εργασίας του excel.

Παρακαλώ βοηθήστε ...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

'****Δήλωση αντικειμένων και μεταβλητών*******

Dim xRgSel ως εύρος Dim xOutApp ως αντικείμενο Dim xMailItem ως αντικείμενο Dim xMailBody ως συμβολοσειρά Dim mailTo ως συμβολοσειρά

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

Φύλλα ("TargetSheet").Range("TargetRange").Επιλέξτε

Application.ScreenUpdating = False Application.DisplayAlerts = False

'Set xRg = Range("A" & Rows.Count).End(xlUp).Row

Ορισμός xRg = Εύρος ("A2:DA1000")
Ορισμός xRgSel = Τομή (Στόχος, xRg)


ActiveWorkbook. Αποθήκευση
'***********Άνοιγμα εφαρμογής του Outlook************

Αν δεν είναι το xRgSel είναι τίποτα τότε

Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xMailItem = xOutApp.CreateItem(0)

xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" στο φύλλο εργασίας " & Me.Name & "" τροποποιήθηκαν στο " & _
Μορφή$(Τώρα, "μμ/ηη/εεεε") & "στο " & Μορφή$(Τώρα, "ωω:μ:δ") & _
" από " & Environ$("όνομα χρήστη") & "."
'************Εύρεση λίστας παραληπτών************

If Cells(xRgSel.Row, "A").Value = "Pankaj" Τότε

mailTo = "pank12***@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Nitin" Τότε

mailTo = "pank****@gmail.com"

End If

If Cells(xRgSel.Row, "A").Value = "Chandan" Τότε

mailTo = "pakxro**@gmail.com"

End If
'****************Σύνταξη email****************

Με το xMailItem

.Προς = ταχυδρομείοΠρος
.Subject = "Το φύλλο εργασίας τροποποιήθηκε στο" & ThisWorkbook.FullName
.Body = xMailBody
'.Attachments.Add (This Workbook.FullName)
.Απεικόνιση

Τέλος με

Ορισμός xRgSel = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Ορισμός xMailItem = Τίποτα

End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ Pankaj Shukla,
Δημοσιεύστε την ερώτησή σας στο Excel στο φόρουμ μας: https://www.extendoffice.com/forum.html για να λάβετε περισσότερες υποστηρίξεις για το Excel από τον επαγγελματία μας στο Excel.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Κατάφερα να δημιουργήσω τη μακροεντολή, ωστόσο αντιμετωπίζω ένα πρόβλημα. Θα ήθελα να στέλνω αυτόματα ένα μήνυμα ηλεκτρονικού ταχυδρομείου όταν ένα κελί φτάσει σε ένα συγκεκριμένο όριο. Το κελί είναι ένας τύπος. Όταν το άθροισμα υπολογισμού πέσει κάτω από το εν λόγω όριο δεν κάνει τίποτα. Ωστόσο, αν πληκτρολογήσω απευθείας στο κελί, θα επεξεργαστεί τη μακροεντολή όπως έχει προγραμματιστεί. Μπερδεύει ο τύπος τη μακροεντολή;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Sissy Jones,
Η μέθοδος σε αυτό το άρθρο: Πώς να στείλετε αυτόματα email με βάση την τιμή του κελιού στο Excel;
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html μπορεί να σας βοηθήσει να λύσετε το πρόβλημα.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αγαπητέ διαχειριστή,


Χρειάζομαι τη βοήθειά σου,



Έχω ένα excel για να παρακολουθώ τις λεπτομέρειες της καθημερινής εργασίας που κάνει ο εργαζόμενός μας από το πεδίο, επομένως είναι δυνατόν να ενεργοποιηθεί ένα μήνυμα από το φύλλο excel, εάν αυτός ο τύπος δεν ενημέρωσε τα δεδομένα σε αυτό το φύλλο excel τη δεδομένη στιγμή.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Δεν μπορώ να βοηθήσω με αυτό.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αν θέλω να στείλω την τιμή του κελιού αντί για τη διεύθυνση.. τότε τι πρέπει να αλλάξω στον κωδικό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Μπορείτε να δοκιμάσετε τον παρακάτω κώδικα VBA.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Dim xRgSel ως εύρος
Dim xOutApp ως αντικείμενο
Dim xMailItem ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ορισμός xRg = Εύρος ("A2:E11")
Ορισμός xRgSel = Τομή (Στόχος, xRg)
ActiveWorkbook. Αποθήκευση
Αν δεν είναι το xRgSel είναι τίποτα τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
xRgSel.Value & _
" στο φύλλο εργασίας " & Me.Name & "" τροποποιήθηκαν στο " & _
Μορφή$(Τώρα, "μμ/ηη/εεεε") & "στο " & Μορφή$(Τώρα, "ωω:μ:δ") & _
" από " & Environ$("όνομα χρήστη") & "."

Με το xMailItem
.To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου"
.Subject = "Το φύλλο εργασίας τροποποιήθηκε στο" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
.Απεικόνιση
Τέλος με
Ορισμός xRgSel = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Ορισμός xMailItem = Τίποτα
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Τι γίνεται αν θέλουμε μόνο τα ενημερωμένα σχόλια σε αυτό το κελί και όχι ολόκληρη την τιμή του κελιού Θα πρέπει να εμφανίζει μόνο τα πιο πρόσφατα σχόλια που προστέθηκαν στο κελί
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Το καταλάβατε;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Υπέροχες πληροφορίες.
Ερώτηση σχετικά με τις πληροφορίες που μπορούν να προστεθούν στο email.
Χρησιμοποιώντας το παραπάνω παράδειγμα....

Εάν είχατε μια τιμή στο F4, πώς θα συμπεριλάβατε την τιμή F4 στο email που δημιουργήθηκε όταν τροποποιήθηκε το D4;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
αν πρέπει να στείλω ολόκληρη τη σειρά τότε;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δοκίμασα τον παραπάνω κώδικα VBA: Στείλτε email εάν το κελί σε μια καθορισμένη περιοχή έχει τροποποιηθεί στο Excel. Αυτό το VBA λειτουργεί για μένα εκτός από την αποστολή email. Όταν τα δεδομένα τροποποιούνται στο δεδομένο εύρος δημιουργείται αυτόματα ένα email με τροποποιημένα στοιχεία κελιού. Ωστόσο, το email δεν αποστέλλεται αυτόματα στον παραλήπτη και ο χρήστης πρέπει να κάνει κλικ στο κουμπί αποστολής στο email. Αυτό που ψάχνω εδώ είναι ότι το email πρέπει να σταλεί αυτόματα στους παραλήπτες όταν δημιουργηθεί. Παρακαλώ βοηθήστε με να δώσω έναν κωδικό για αυτό. Πολλά ευχαριστώ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Jimmy Joseph,
Αντικαταστήστε τη γραμμή ".Display" με ".Send". Ελπίζω να μπορώ να βοηθήσω. Ευχαριστώ για το σχόλιο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια; υπάρχει τρόπος να αλλάξετε το κείμενο που εμφανίζεται χρησιμοποιώντας πληροφορίες από άλλα κελιά (από την πρώτη γραμμή και την πρώτη στήλη); για παράδειγμα, εάν αλλάξω το κελί K15, θέλω να συμπεριλάβω στο μήνυμα πληροφορίες για τα κελιά A15 και K1; τι να αλλάξω στον κωδικό; Ευχαριστώ πολύ
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια σου Laona. μήπως μάθετε πώς μπορείτε να το κάνετε αυτό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας. Πώς μπορώ να τροποποιήσω τον κώδικα, ώστε ένα μήνυμα ηλεκτρονικού ταχυδρομείου να αποσταλεί σε άλλη διεύθυνση ηλεκτρονικού ταχυδρομείου εάν τροποποιηθεί μια άλλη περιοχή κελιών;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Κάποια βοήθεια σχετικά με αυτό το αίτημα; Έχω το ίδιο θέμα. Θέλω να προσθέσω πολλές διευθύνσεις email ανά σειρά, αλλά όταν αλλάζω μία σειρά, αλλάζει ολόκληρο το φύλλο εργασίας. Πώς μπορώ να περιορίσω τις αλλαγές μόνο σε μία σειρά;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Επεξεργασία γραμμής:
1). Στον κωδικό, το A2:E11 είναι το εύρος στο οποίο θα στείλετε email με βάση.
και
3). Αντικαταστήστε τη διεύθυνση email με τη διεύθυνση email του παραλήπτη στη γραμμή .To = "Email Address".

Λειτουργεί το πρόστιμο.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μπορείτε να το εξηγήσετε αυτό περαιτέρω. Πώς επαναλαμβάνετε τον κώδικα για αποστολή σε διαφορετικό email με βάση άλλο εύρος που τροποποιείται. Προσπάθησα να αντιγράψω και να επικολλήσω τον παρακάτω κώδικα και να αλλάξω σύμφωνα με το σχόλιό σας, αλλά και πάλι μόνο το πρώτο εύρος φαίνεται να εκτελεί την εντολή και να γράφει το email.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έχει κανείς απάντηση σε αυτό;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, προσπαθούσα να στείλω email στο φύλλο μου χρησιμοποιώντας μια τιμή που άλλαξε στο φύλλο. Εάν στη στήλη H η κατάσταση αλλάξει σε "4" το αναγνωριστικό παραγγελίας στα αριστερά θα πρέπει να αποσταλεί σε έναν χρήστη. Το φύλλο λειτουργεί δυναμικά, επομένως έχω ένα εύρος από D9:D140 όπου αποθηκεύονται τα αναγνωριστικά παραγγελίας και οι αλλαγές κατάστασης γίνονται στο ίδιο εύρος στο H9:H140. Πώς μπορώ να επιτύχω τον στόχο να το κάνω και να στείλω το αναγνωριστικό παραγγελίας στον πελάτη μου όταν η κατάσταση έχει αλλάξει σε "4";
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θα ήταν δυνατό να εμφανιστεί ένα διαφορετικό κελί αναφοράς στο xMailBody στην ίδια στήλη αντί για τις τροποποιημένες διευθύνσεις κελιών;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Sam, εννοείς να επιλέξεις τυχαία ένα κελί αναφοράς στην ίδια στήλη της τροποποιημένης διεύθυνσης κελιού; Ή πληκτρολογήστε με μη αυτόματο τρόπο ένα κελί αναφοράς στη γραμμή xMailBody του κώδικα; Είναι εύκολο να πληκτρολογήσετε με μη αυτόματο τρόπο ένα κελί αναφοράς στον κώδικα, απλώς περικλείστε το κελί αναφοράς με διπλά εισαγωγικά όπως φαίνεται παρακάτω: xMailBody = "Κελιά(α)" & "Δ3" & ", " & "Δ8" & _

Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Είναι δυνατόν να αλλάξει αυτό, ώστε να εμφανίζει το email μόνο εάν ένα κελί σε ένα εύρος έχει αλλάξει σε "Ναι". Θα ήθελα να μην κάνει τίποτα αν έχει κάποια άλλη αξία.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Ευχαριστώ για τον κωδικό, αυτός ο κωδικός λειτουργεί όταν εισάγω την τιμή και πατήσω enter. Αλλά στην περίπτωσή μου το κελί γεμίζει αυτόματα με τύπο και όταν επιτευχθεί η τιμή δεν ανοίγει το email, οπότε ο κώδικας δεν λειτουργεί σε αυτήν την περίπτωση. Ευχαριστώ εκ των προτέρων!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια hakana,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Δοκιμάστε το. Ευχαριστούμε για την ανταπόκρισή σας.

Ιδιωτικό δευτερεύον φύλλο εργασίας_Αλλαγή (ByVal Στόχος ως εύρος)
«Ενημερώθηκε από Extendoffice 2022 / 04 / 15
Dim xRgSel ως εύρος
Dim xOutApp ως αντικείμενο
Dim xMailItem ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
Dim xBoolean ως Boolean
Dim xItsRG ως εύρος
Dim xDDs As Range
Dim xDs As Range
On Error Συνέχιση Επόμενη
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBoolean = Λάθος
Ορισμός xRg = Εύρος ("E2:E13")

Ορισμός xItsRG = Τομή (Στόχος, xRg)
Ορισμός xDDs = Intersect(Target.DirectDependents, xRg)
Ορισμός xDs = Intersect(Target.Dependents, xRg)
Αν όχι (το xItsRG δεν είναι τίποτα) Τότε
Ορίστε xRgSel = xItsRG
xBoolean = Αληθινό
ElseIf Not (το xDDs Is Nothing) Τότε
Ορίστε xRgSel = xDDs
xBoolean = Αληθινό
ElseIf Not (xDs Is Nothing) Τότε
Ορίστε xRgSel = xDs
xBoolean = Αληθινό
End If


ActiveWorkbook. Αποθήκευση
Αν xBoolean Τότε
Εντοπισμός σφαλμάτων.Εκτύπωση xRgSel.Διεύθυνση


Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" στο φύλλο εργασίας " & Me.Name & "" τροποποιήθηκαν στο " & _
Μορφή$(Τώρα, "μμ/ηη/εεεε") & "στο " & Μορφή$(Τώρα, "ωω:μ:δ") & _
" από " & Environ$("όνομα χρήστη") & "."

Με το xMailItem
.To = "Διεύθυνση ηλεκτρονικού ταχυδρομείου"
.Subject = "Το φύλλο εργασίας τροποποιήθηκε στο" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
.Απεικόνιση
Τέλος με
Ορισμός xRgSel = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Ορισμός xMailItem = Τίποτα
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, έχω δημιουργήσει έναν παρόμοιο κωδικό, αλλά θα ήθελα να *** μια συνθήκη όπου εάν διαγραφεί μια τιμή κελιού, δεν θα στέλνει μήνυμα ηλεκτρονικού ταχυδρομείου όταν αποθηκευτεί/κλείσει. Θα στείλει ένα email μόνο όταν έχει εισαχθεί μια τιμή κελιού. Ξέρετε πώς να το κάνετε αυτό; Αυτός είναι ο κωδικός μου:

ΚΩΔΙΚΟΣ ΓΙΑ ΑΥΤΟΜΑΤΗ ΑΠΟΣΤΟΛΗ EMAIL ΣΕ ΚΑΠΟΙΟΝ ΟΤΑΝ ΕΝΗΜΕΡΩΘΕΙ ΤΟ ΒΙΒΛΙΟ ΕΡΓΑΣΙΑΣ EXCEL

ΚΩΔΙΚΟΣ ΦΥΛΛΟΥ:

Επιλογή Ρητή «Εύρος συμβάντων αλλαγής φύλλου εργασίας του Excel
Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
Εάν δεν διασταυρώνεται (Στόχος, Εύρος ("C3:D62")) Δεν είναι τίποτα τότε
'Target.EntireRow.Interior.ColorIndex = 15
Εύρος ("XFD1048576").Τιμή = 15
End If
If Not Intersect(Target, Range("I3:J21")) Is Nothing then
'Target.EntireRow.Interior.ColorIndex = 15
Εύρος ("XFD1048576").Τιμή = 15
End If
Sub End


ΚΩΔΙΚΟΣ ΒΙΒΛΙΟΥ ΕΡΓΑΣΙΑΣ:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Me.Saved = False Τότε Me.Save

Dim xOutApp ως αντικείμενο
Dim xMailItem ως αντικείμενο
Dim xName As String

If Range("XFD1048576").Τιμή = 15 Τότε
On Error Συνέχιση Επόμενη
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
Με το xMailItem
.To = "email"
.CC = ""
.Subject = "μήνυμα"
.Body = "μήνυμα!"
.Συνημμένα.*** xName
.Απεικόνιση
'.στείλετε
Τέλος με
End If
Ορισμός xMailItem = Τίποτα
Ρύθμιση xOutApp = Τίποτα



Sub End

Ιδιωτικό Sub Workbook_Open ()
Εύρος ("XFD1048576"). Διαγραφή
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σε όλους,

der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die geändert wurden? So wie es jetzt ist ,würde er jede geänderte Zelle einzeln senden. Dies ist dann problematisch wenn zB 10 Zellen angepasst werden ήταν 10 E-Mails beeuten würde. Und gibt es die Möglichkeit, die gesamte geänderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die Änderung nicht mehr finden.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Esser123,
Οι παρακάτω κωδικοί VBA μπορούν να βοηθήσουν. Αφού τροποποιήσετε τα κελιά στο καθορισμένο εύρος και αποθηκεύσετε το βιβλίο εργασίας, θα εμφανιστεί ένα μήνυμα ηλεκτρονικού ταχυδρομείου που θα περιλαμβάνει όλα τα τροποποιημένα κελιά στο σώμα του ηλεκτρονικού ταχυδρομείου και το βιβλίο εργασίας θα εισαχθεί επίσης ως συνημμένο στο μήνυμα ηλεκτρονικού ταχυδρομείου. Παρακαλούμε ακολουθήστε τα παρακάτω βήματα:
1. Ανοίξτε το φύλλο εργασίας που περιέχει τα κελιά στα οποία θέλετε να στείλετε μηνύματα ηλεκτρονικού ταχυδρομείου, κάντε δεξί κλικ στην καρτέλα του φύλλου και κάντε κλικ Προβολή κωδικού από το μενού με το δεξί κλικ. Στη συνέχεια, αντιγράψτε τον παρακάτω κώδικα στο παράθυρο φύλλου(κωδικού).
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. Στο πρόγραμμα επεξεργασίας της Visual Basic, κάντε διπλό κλικ Αυτό το βιβλίο εργασίας στο αριστερό παράθυρο και, στη συνέχεια, αντιγράψτε τον ακόλουθο κώδικα VBA στο Αυτό το βιβλίο εργασίας (Κωδικός) παράθυρο.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χρειάζομαι βοήθεια για την ενεργοποίηση ενός email με μια μικρή αλλαγή. Αντί για μια αριθμητική τιμή ή για την εισαγωγή των πληροφοριών στο κελί με μη αυτόματο τρόπο, τα κελιά στη στήλη Β θα αλλάξουν σε "Y" που ενεργοποιείται από έναν τύπο σε άλλα κελιά σε αυτήν τη σειρά. Ο τύπος για τη στήλη Β είναι =IF([@[Ποσότητα σε απόθεμα]]>[@[Επίπεδο αναδιάταξης]],"Y"), που δείχνει ότι το απόθεμα είναι χαμηλό σε απόθεμα και χρειάζεται εκ νέου παραγγελία. Πρέπει να ενεργοποιήσω ένα αυτοματοποιημένο μήνυμα ηλεκτρονικού ταχυδρομείου όταν μια τιμή κελιού αλλάζει στη στήλη Β σε 'Y', επομένως ειδοποιούμαι αυτόματα μέσω email για το χαμηλό απόθεμα. Δοκίμασα ό,τι μπορώ να σκεφτώ για την αλλαγή κωδικών που έχουν ήδη δοθεί, αλλά τίποτα δεν φαίνεται να λειτουργεί για μένα... παρακαλώ βοηθήστε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Kathryn F,
Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να λύσετε το πρόβλημα. Δοκιμάστε το. Σας ευχαριστούμε για το σχόλιό σας.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Private Sub Worksheet_Calculate()
Dim xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας και σας ευχαριστώ για αυτό το σεμινάριο.
J'ai cependant une hardé pour l'application de la plage de recherche.
Dans le code, j'ai demandé à vérifier la plage C2:C4.
Το fonctionne bien si je τροποποιεί τη μοναδικότητα C2, C3 ή C4. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Παράδειγμα, ως je τροποποίηση C2 και C4 χωρίς τροποποιητή C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Merci d'avance.

Προσωπικό φύλλο εργασίας Sub_change (ByVal Target As Range)
«Ενημερώθηκε από Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg ως εύρος

xAddress = "C2:C4"
Ορισμός xDRg = Εύρος (xΔιεύθυνση)
Ορισμός xRgSel = Τομή (Στόχος, xDRg)
Σε σφάλμα Μετάβαση στο Err1
Αν δεν είναι το xRgSel είναι τίποτα τότε
Εάν ThisWorkbook.gChangeRange = "" Τότε
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Αλλού
Ορισμός xRg = Εύρος (ThisWorkbook.gChangeRange)
Ορισμός xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Έξοδος Sub
Σφάλμα 1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Sub End


-----

Επιλογή ρητή
Δημόσιο gChangeRange ως συμβολοσειρά
Private Sub Workbook_AfterSave (ByVal Success As Boolean)
«Ενημερώθηκε από Extendoffice 20220921
Dim xRgSel, xRg ως εύρος
Dim xOutApp ως αντικείμενο
Dim xMailItem ως αντικείμενο
Dim xMailBody ως συμβολοσειρά
'On Error Συνέχιση Επόμενο
Σε σφάλμα Μετάβαση στο Err1
Ορισμός xRg = Εύρος (gChangeRange)
Αν δεν είναι το xRg είναι τίποτα τότε
Ορισμός xOutApp = CreateObject ("Outlook.Application")
Ορισμός xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address(False)fLfCrLf, & "Cordialement"
Με το xMailItem
.To = "x.xxxxxx@xxxx.fr"
.Subject = "Données modifiées " & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
.Απεικόνιση
Τέλος με
Ορισμός xRgSel = Τίποτα
Ρύθμιση xOutApp = Τίποτα
Ορισμός xMailItem = Τίποτα
End If
Σφάλμα 1:
gChangeRange = ""
Sub End
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Θα ήθελα να στείλω το email σε 5 άτομα. Τι οριοθέτηση χρησιμοποιείται μεταξύ κάθε διεύθυνσης email;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Τζο,
Χρησιμοποιήστε ένα ερωτηματικό για να διαχωρίσετε τις διευθύνσεις email.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Εδώ είναι μια άλλη ερώτηση. Εάν αλλάξει ένα κελί, στέλνει ένα email. αν αλλάξουν 3 κελιά, στέλνει 3 email. Πώς μπορείτε να το σταματήσετε αυτό, ώστε να στέλνει μόνο 1 email όταν ολοκληρωθούν οι αλλαγές;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Τζο,
Ας υποθέσουμε ότι έχετε καθορίσει την περιοχή ως "A2:E11" στον κωδικό. Πώς μπορώ να επαληθεύσω πότε έχουν ολοκληρωθεί όλες οι επεξεργασίες;
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

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

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