hier der Code meiner Listbox welche dann die gesuchte Maschine mit den jeweiligen spalten in eine Tabelle einträgt.
Option Explicit
Private Sub cmdSuchen_Click()
Dim lngRow As Long, lngLast As Long
If TextBox1.text "" Then
With Sheets("Maschinenliste")
lngLast = Application.Max(19, .Cells(.Rows.Count, 1).End(xlUp).Row)
ListBox1.Clear
For lngRow = 19 To lngLast
If .Cells(lngRow, 5).Value = TextBox1 Then
ListBox1.AddItem Cells(lngRow, 1).text
ListBox1.Column(0, ListBox1.ListCount - 1) = .Cells(lngRow, 3).text
ListBox1.Column(1, ListBox1.ListCount - 1) = .Cells(lngRow, 4).text
ListBox1.Column(2, ListBox1.ListCount - 1) = .Cells(lngRow, 5).text
ListBox1.Column(3, ListBox1.ListCount - 1) = .Cells(lngRow, 24).text
ListBox1.Column(4, ListBox1.ListCount - 1) = .Cells(lngRow, 13).Value
End If
Next
End With
Else
MsgBox "Kein gültige Seriennummer!"
End If
End Sub
Private Sub CommandButton2_Click()
'Erstellen der Email für Outlook
Dim objOutlook As Object, objMail As Object
Dim lngIndex As Long, HTML As String, bolStripe As Boolean, strColor As String
With ListBox1
If .ListCount > 0 Then
HTML = _
"
"
HTML = HTML & _
"Typ:"
HTML = HTML & " Größe: "
HTML = HTML & "Seriennummer: "
HTML = HTML & "Bemerkung: "
For lngIndex = 0 To .ListCount - 1
Select Case .List(lngIndex, 4)
Case "0": strColor = "red"
Case "1": strColor = "#e6e600"
Case "2": strColor = "green"
Case Else: strColor = "#000000"
End Select
HTML = HTML & "" & .List(lngIndex, 0) & " "
HTML = HTML & "" & .List(lngIndex, 1) & " "
HTML = HTML & "" & .List(lngIndex, 2) & " "
HTML = HTML & "" & .List(lngIndex, 3) & " "
bolStripe = Not bolStripe
Next
HTML = HTML & "
Else
MsgBox "Keine Maschinendaten vorhanden!"
End If
End With
If Len(HTML) Then
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "markus.schindler@haitiangermany.com"
.CC = ""
.BCC = "rene.kiesewetter@haitiangermany.com"
.Subject = "Maschinenstatus"
.HTMLBody = "Hallo zusammen,
wie ist der Status folgender Maschine ? :
" & HTML _
_
& "
Grüße " & "
" & Application.UserName
.Display 'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend _
manuell vom User!
End With
End If
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
Private Sub CommandButton3_Click()
TextBox1.Value = ""
ListBox1.Clear
End Sub
Private Sub Label14_Click()
End Sub
Private Sub Label27_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
'Zentrieren auf beiden Bildschirmen des Fenstern
Private Sub UserForm_Initialize()
Dim sngTop As Single, sngLeft As Single
Me.StartUpPosition = 0
sngLeft = Application.Left + Application.Width / 2 - Me.Width / 2
sngTop = Application.Top + Application.Height / 2 - Me.Height / 2
Me.Left = sngLeft
Me.Top = sngTop
Label13 = Date
Label28 = Time
'Spaltenbreite festlegen
ListBox1.ColumnCount = 5
ListBox1.ColumnWidths = "30 Pt;60 Pt;100 Pt;100 Pt;0 Pt"
End Sub
Ich würde gerne im Betreff den Inhalt von Spalte 3,4,5 Anhängen lassen automatisch.Kann mir da jemand mit dem Code helfen?
Danke :)