Office: (Office 365) Intelligent eTabelle bestimmter Zellbereich markieren VBA

Hi Martin,

da solltest du schon mal deine aktuelle Mappe hochladen.

---

 

Hallo Karin,
wie gewünscht die Datei.
was mir noch eingefallen ist. Es muss nicht zwingend gefiltert werden. Es müsste halt nur die richtigen Zeilen Kopiert werden.
Gruß
Martin

 

Hi Martin,

so sollte es funktionieren:

Code:

Private Sub Auswählen_Click()
    Dim strAuswahl As ListObject
    Dim varAuswahl As Variant
    Set strAuswahl = Tabelle1.ListObjects("tbl_ÄnderungenSchaltzeiten")
    If ID_1 = "" And ID_2 = "" And ID_3 = "" And ID_4 = "" Then
        MsgBox "Bitte mindestens 1 ID Nr. eintragen"
    Else
        strAuswahl.AutoFilter.ShowAllData
        strAuswahl.Range.AutoFilter Field:=1, Criteria1:=Array(ID_1.Value, ID_2.Value, ID_3.Value, ID_4.Value), Operator:=xlFilterValues
        '************************
        ' Fehlerbehandlung falls keine gefilterten Zeilen
        On Error Resume Next
        varAuswahl = strAuswahl.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
        On Error GoTo 0
        '************************
        ' gefilterte Zeilen kopieren wenn tatsächlich welche vorhanden sind
        If varAuswahl > 0 Then
            Range("tbl_ÄnderungenSchaltzeiten[[ID]:[Wer]]").Copy
            Cancel = True
            Application.CutCopyMode = False
        Else
            MsgBox "Keine ID gefunden"
        End If
        strAuswahl.AutoFilter.ShowAllData
    End If
End Sub

---

 

Hallo Karin,
wow !
Das möchte ich auch können, einfach mal so ein Code schreiben.
So habe ich mir das vorgestellt. Jetzt kann ich das weiter ausführen.
Vielen Dank und ein schöne WW
Martin

 

hallo Karin,
und schon wieder ich
Bei der weiteren Ausführung meinem Projekt bin ich auf ein weiteres Problem gestoßen.
Wie gesagt klappt ja alles habe es auch hinbekommen die Kopierten Zeilen in Outlook einzufügen.
Dabei ist mir aufgefallen das es besser aussehen würde wenn die Überschriften dabei wären.
Habe schon einiges probiert, leider ohne Erfolg.
Kannst du mir nochmal helfen.
Danke
Gruß
Martin

 

Hi Martin,

dann so:

Code:

        If varAuswahl > 0 Then
            Dim rngBereich As Range
            ' Bereich aus Überschrift und gefilterten Zeilen zusammensetzen
            Set rngBereich = Union(Range("tbl_ÄnderungenSchaltzeiten[[#Headers],[ID]:[Wer]]"), _
                Range("tbl_ÄnderungenSchaltzeiten[[ID]:[Wer]]"))
            rngBereich.Copy
            Application.CutCopyMode = False
        Else
            MsgBox "Keine ID gefunden"
        End If

Die Codezeile Dim rngBereich As Range kannst du selbstverständlich an den Anfang der Prozedur zu den anderen Dimansionierungen verschieben - sie steht nur deshalb an dieser Stelle hier, damit ich nicht noch einmal die gesamte Prozedur kopieren musste, du aber sehen kannst, wie die Variable deklariert ist.

---

 

Hallo Karin,
ich bin einfach nur Begeistert.
Code passt.
Danke
Martin

 

Hallo Karin,
Ja ich schon wieder
Eigentlich war ich so gut wie fertig aber mir gefiel das ganze nicht wie der Bereich in Outlook eingefügt wird. Habe deshalb im Outlook Forum eine Anfrage gestartet.
htmlBody nach Bild weiteren Text einfügen (office-hilfe.com)
Andreas hatte mir versucht zu helfen, aber ich glaube ich bin zu dämlich. Denn alle Hilfe die er mir gab konnte ich einfach nicht in mein Projekt umsetzen.
Nun setze ich mein Ganze Hoffnung mal wieder auf dich
Nochmals zur kurzen Erklärung
Nach dem, in Outlook eingefügten Bereich, will ich noch etwas schreiben.
Du hattes mal geschrieben das geht nur wenn man den Bereich Speichert und dann in Outlook wieder einfügt
Bild aus Excel mittels VBA in Email einfügen (office-hilfe.com)
Verstanden habe ich das, aber ich bekomme es ums Verre..... nicht hin den kopierten Bereich als Bild zu speichern
Auch nicht mit dem Link von Andreas.
Angefügt mein kompletter Code und die Datei

Code:

Private Sub Auswählen_Click()
    Dim strAuswahl As ListObject
    Dim varAuswahl As Variant
    Dim rngBereich As Range
    Set strAuswahl = Tabelle1.ListObjects("tbl_ÄnderungenSchaltzeiten")
    If ID_1 = "" And ID_2 = "" And ID_3 = "" And ID_4 = "" Then
        MsgBox "Bitte mindestens 1 ID Nr. eintragen"
    Else
        strAuswahl.AutoFilter.ShowAllData
        strAuswahl.Range.AutoFilter Field:=1, Criteria1:=Array(Senden.ID_1.Value, Senden.ID_2.Value, Senden.ID_3.Value, Senden.ID_4.Value), Operator:=xlFilterValues
        '************************
        ' Fehlerbehandlung falls keine gefilterten Zeilen
        On Error Resume Next
        varAuswahl = strAuswahl.DataBodyRange.Columns(1).SpecialCells(xlCellTypeVisible).Count
        On Error GoTo 0
        '************************
        ' gefilterte Zeilen kopieren wenn tatsächlich welche vorhanden sind
        If varAuswahl > 0 Then
        Set rngBereich = Union(Range("tbl_ÄnderungenSchaltzeiten[[#Headers],[Von]:[Wer]]"), _
                Range("tbl_ÄnderungenSchaltzeiten[[Von]:[Wer]]"))
           rngBereich.CopyPicture
            Application.CutCopyMode = False

        Else
            MsgBox "Keine ID gefunden"
    End If
      Range("tbl_ÄnderungenSchaltzeiten[[Senden]]").Value = "gesendet am " & Date
   
        strAuswahl.AutoFilter.ShowAllData
    End If
    Unload Me
  'Ab hier Outlook
  Dim olApp As Object
   Dim Signatur As String
   Dim sMailtext As String

    Set olApp = CreateObject("Outlook.Application")
   
    With olApp.CreateItem(0)
        .GetInspector.Display
         Signatur = .htmlbody
        .GetInspector.Display
        .Recipients.Add ": service@recogizer.de" 'Empfänger
        .CC = "m.Bartsch@engelhorn.de;s.kirchgessner@engelhorn.de" 'CC
        .Subject = "Änderungen der Schaltzeiten vom " & Date   'Betreff
   
        sMailtext = "<p style='font-family:calibri;font-size:11pt'>Hallo zusammen," & vbLf _
                  & "Anbei die Änderungen der Schaltzeiten </p>" & vbLf                                'Nachricht
               
       .htmlbody = Replace(sMailtext, vbLf, "<br>")
       
        With .GetInspector.WordEditor.Application.Selection
           .Start = Len(sMailtext): .End = Len(sMailtext)
           .Paste          ' Grafik in Mail einfügen
       
        End With
        .ReadReceiptRequested = False
        'Lesebestätigung aus
        .Display
        'Zeigt E-Mail an, ohne zu senden

    End With
    Set olApp = Nothing
 
End Sub

Danke vorab für die Hilfe
Gruß
Martin

 

Hi Martin,

es gibt noch eine andere Möglichkeit: man kann den Zellbereich direkt in HTML-Text umwandeln - dazu hatte Ron de Bruin vor Jahren einen Code geschrieben, der aber auch heute noch vom Prinzip her funktioniert. Ich hatte allerdings Probleme beim Einbinden in deinen bereits vorhandenen Code, da er zwar in meiner eigenen Mappe funktionierte, in deiner jedoch nicht. Deshalb hat es etwas länger gedauert, sodass ich erst jetzt antworten kann.

Ich habe ein neues Modul mit Namen "HTMLerstellen" erstellt und dort die Function von Ron eingefügt. Sie wird aus deinem ursprünglichen Code vom CommandButton im UserForm aus aufgerufen - deinen Code musste ich außerdem noch etwas anpassen. Ich hoffe, dass alles nun deinen Wünschen entspricht.

---

 

oh Gott Karin bloß kein stress!!!!
Ich bin ja froh das du es mir gelöst hast..
Was soll ich sage wieder einmal perfekt.
Kurze Frage: der Code von Ron, kann man diesen einfach für andere Projekte nutzen oder muss er immer angepasst werden?
Also vielen lieben Dank nochmal.
Gruß
Martin

 

Hi Martin,

du kannst ihn selbstverständlich auch für andere Fälle verwenden - immer dann, wenn du den Ausschnitt eines Tabellenblattes als HTML-Body in eine E-Mail einbinden möchtest. Verändern brauchst du ihn eigentlich nicht, da er alles Erforderliche erledingt, wenn die Funktion korrekt aufgerufen wird: man schreibt den zu exportierenden Zellbereich am besten auf eine Variable und übergibt diese dann an die Function.
Ich denke, ich muss dich nicht extra darauf hinweisen, dass man den Hinweis auf den Codeersteller (wenn solch ein Hinweis vorhanden ist) generell im Code belassen sollte.

---

 

Hallo Karin, Hallo zusammen,
warum muss das Leben so Kompliziert sein und warum kann es nicht mal einfach sein.

Wie ja gesagt läuft die Lösung von Karin perfekt.
Jetzt wollte ich einige Anpassungen machen und schon funktioniert es nicht mehr wie Vorher
Ich wollte die Spalte Anlage als Dropdown machen. Die Daten kommen von einer Intelligente Tabelle (tbl_Anlagen)die ab Spalte N3 steht.
Sobald ich dieses einrichte wird nicht mehr der Gefilterte Bereich nach Outlook eingefügt sondern die ganze Tabelle (tbl_ÄnderungenSchaltzeiten)
Warum funktioniert das nicht? Oder mache ich was falsch? Die tbl_Anlagen würde ich gerne auf dem selben Tabellenblatt haben da so der Benutzer eine Überblick hat.
Danke schon mal im Voraus
Gruß
Martin

 

Hi Martin,

warum es nicht funktioniert kannst nur du allein feststellen, denn nur du allein kennst die aktuelle Arbeitsmappe und ihren Aufbau...

---

 

Hallo Karin,
stimmt hätte ich dran denken können das es immer besser ist die aktuelle Datei hinzuzufügen. (war gestern spät)
So sieht sie jetzt aus.
Gruß
Martin

 

Hi Martin,

ändere in der Function die Zeile

Code:

    rng.Copy

in diese

Code:

    rng.SpecialCells(xlCellTypeVisible).Copy

---