Zwei VBA starten

[Franke]

Hallo,

ich habe ein Problem,

wie starte ich zwei VBA,
Das Problem habe ich verstanden weil zweimal der gleiche Namen darin  steht.
Aber ich weis nicht wie man das löst. Wie benenne ich das zweite VBA
Wer kann mir da weiterhelfen.


  3 Abarbeitung_Serviceaufträge.xlsm (Größe: 168,84 KB / Downloads: 7)

[cysu11]

Hi,

du meinst die Worksheet Change Ereignisse?

Zusammenfügen, so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

  ' Überprüfen, ob sich die Änderung innerhalb des gewünschten Bereichs befindet
  If Not Intersect(Target, Me.Range("M5:M100")) Is Nothing Then

    ' Schleife über die betroffenen Zellen
    For Each cell In Intersect(Target, Me.Range("M5:M100"))

      ' Überprüfen, ob der Wert der Zelle "x" ist
      If UCase(cell.Value) = "X" Then

        ' Outlook starten und E-Mail erstellen
        Dim OutApp As Object, OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
          .To = "empfaenger@email.de" ' Empfängeradresse anpassen
          .CC = "" ' CC-Adresse(n) anpassen
          .BCC = "" ' BCC-Adresse(n) anpassen
          .Subject = "Betreff der E-Mail" ' Betreff anpassen
          .Body = "Hallo,\n\nDies ist eine automatisch generierte E-Mail." & vbNewLine & vbNewLine & _
                  "Die Zelle " & cell.Address & " wurde geändert." ' Nachricht anpassen
          .Display ' E-Mail anzeigen (oder .Send zum direkten Senden)
        End With

        ' Objekte freigeben
        Set OutMail = Nothing
        Set OutApp = Nothing

      End If
    Next cell
  End If
 
If Intersect(Target, Range("L2:L500")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 5).ClearContents
    Else
        Target.Offset(0, 5) = CDate(Format(Now, "dd.mm.yyyy"))
End If

End Sub

[slowboarder]

Hi
einen Makronamen kann es innerhalb eines Moduls nur 1x geben.
wenn du jetzt für mehrere Zellbereiche so ein automatisch startendes Makro haben willst (Worksheet_Change), dann musst du das in einem Makro zusammenfassen, da es dieses Makro nur einmal geben darf die automatische Ausführung über den Namen gesteuert wird (dh das Makro muss genauso wie gezeigt benannt sein).

das ist eigentlich auch kein Problem man muss nur die Bedingungsprüfung für die einzelnen Bereiche so schreiben, dass sie sich nicht gegenseitig stören.

in der Regel muss dabei das beliebte
If Bedingung x then Exit Sub
als vollständiger IF-Block geschrieben werden, damit danach noch weitere Bereiche programmiert werden können.

in deinem Fall also:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

  ' Überprüfen, ob sich die Änderung innerhalb des gewünschten Bereichs befindet
  If Not Intersect(Target, Me.Range("M5:M100")) Is Nothing Then

    ' Schleife über die betroffenen Zellen
    For Each cell In Intersect(Target, Me.Range("M5:M100"))
     ....
     ...
    Next Cell
end IF


If Not Intersect(Target, Range("L2:L500")) Is Nothing Then 
    If Target.Count = 1 Then 'Bearbeiten mehrerer Zeilen wird abgefangen
        If Target = "" Then
            Target.Offset(0, 5).ClearContents
        Else
            Target.Offset(0, 5) = CDate(Format(Now, "dd.mm.yyyy"))
        End If
    end if
end if 

End Sub

Dein erstes Makro entspricht ja schon dieser Anforderung, das zweite sollte noch etwas angepasst werden.

[knobbi38]

Hallo,

mal ganz nebenbei: 

So etwas

Code:

        Set OutApp = CreateObject("Outlook.Application")

sollte eigentlich niemals in einer Schleife stehen! 

Knobbi38

[Franke]

Erst mal vielen Dank für die schnelle Hilfe.
Sorry das ich so spät Antworte, ich war Geschäftlich unterwegs.

Dann hätte ich noch eine Frage.
Wenn ich jetzt ein x setze im Bereich  M5:M100 dann öffnet er mir ja Mailprogramm.
Wie kann ich jetzt  wenn ich z.b. in M6 ein X setze, das er die Zeile A6 und B6 ausliest und das in den Betreff schreibt.

[Gast 123]

Hallo

ersetze bitte diese Zeile durch den unteren Code:
          '.Subject = "Betreff der E-Mail" ' Betreff anpassen   'ersetzen durch
          .Subject = Cells(cell.Row, 1) & " " & Cells(cell.Row, 2)   '1=A, 2=B

Mit cell.Row holst du dir die Zeile wo das "x" drinsteht,  1+2 steht für Spalte A/B
Ich hoffe diese einfache Lösung klappt bei dir. Viel Erfolg beim testen.

mfg Gast 123

[HKindler]

          .Subject = Cells(cell.Row, 1) & " " & Cells(cell.Row, 2)   '1=A, 2=B

Mit cell.Row holst du dir die Zeile wo das "x" drinsteht,  1+2 steht für Spalte A/B

Statt 1+2 kann man auch direkt "A"+"B" verwenden:
          .Subject = Cells(cell.Row, "A") & " " & Cells(cell.Row, "B")
Manchmal sind die Buchstaben und manchmal die Zahlen geschickter...

[schauan]

Hallöchen,

PHP-Code:

.Subject = Cells(cell.Row, 1) & " " & Cells(cell.Row, 2)   '1=A, 2=B 


es ist eventuell auch günstiger, Deinen Bereich nicht cell zu nennen sondern vielleicht rngCell.
cell als individuelle Bereichsangabe überliest man vielleicht schnell und wenn Du im Code nach cell suchst, hast Du eventuell auch die ganzen Cells als Ergebnis. Ok, bei letzterem hilft Dir auch die Beachtung der Groß/Kleinschreibung

[Franke]

Vielen Dank für die Lösungen.
Hat wunderbar geklappt.