Erweiterung meines Makros.

Sub BeiKlick() Dim Element As String Dim AnzeigeText As String On Error GoTo MyErrorHandler: Element = Application.Caller MsgBox "Equipmentnr.: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 2, False) & _ _ vbCrLf & "Location: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 3, False) & _ vbCrLf & "Kostenstelle: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 4, False) & vbCrLf & "Gerätetyp: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 5, False) & vbCrLf & "Anzahl Monitore: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 6, False) & vbCrLf & "Standalone: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 7, False) & vbCrLf & "Versorgungsklasse: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 8, False) & vbCrLf & "Sonstiges: " & WorksheetFunction.VLookup(Element, Tabelle1.Range("A:I"), 9, False), vbInformation, Element Exit Sub MyErrorHandler: If Err.Number = 1004 Then MsgBox "Das Objekt wurde falsch zugewiesen oder Eintragung im Datenbestand fehlt!", vbCritical End If End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Max,
den Button kannst du gleich in die MsgBox mit einbauen, indem du Ja/Nein-Schaltfächen anzeigen lässt für die Anzeige des Element in der Quell-Mappe.
Den Code für die Anzeige der Element-Namen kann man etwas übersichtlicher gestalten, wenn man erst die Zeilen-Nummer ermittelt und dann den Anzeigetext berechnet.
Die nächste Hürde:
Wie können Pfad und Name der Mappe mit den Quelldaten ermittelt werden?
Ist das Tabellenblatt mit den Elementdaten fix oder variabel? Wenn varaibel, wie kommt man an den Blattnamen?
Das Makro könnte dann etw wie folgt aussehen.
LG
Franz

Sub BeiKlick()
Dim Element As String
Dim Zeile As Variant
Dim AnzeigeText As String
Dim wkb As Workbook, wks As Worksheet, strMappe As String, varSheet As Variant
On Error GoTo MyErrorHandler:
Element = Application.Caller
With Tabelle1
Zeile = Application.Match(Element, .Range("A:A"), 0)
If IsNumeric(Zeile) Then
AnzeigeText = "Equipmentnr.: " & .Cells(Zeile, 2) _
& vbCrLf & "Location: " & .Cells(Zeile, 3) _
& vbCrLf & "Kostenstelle: " & .Cells(Zeile, 4) _
& vbCrLf & "Gerätetyp: " & .Cells(Zeile, 5) _
& vbCrLf & "Anzahl Monitore: " & .Cells(Zeile, 6) _
& vbCrLf & "Standalone: " & .Cells(Zeile, 7) _
& vbCrLf & "Versorgungsklasse: " & .Cells(Zeile, 8) _
& vbCrLf & "Sonstiges: " & .Cells(Zeile, 9) & vbLf & vbLf _
& "Element in Quelldaten-Datei anzeigen?"
If MsgBox(AnzeigeText, vbQuestion & vbYesNo, _
"Element: " & Element) = vbYes Then
'Ein Button mit dem ich beim geöffneten Objekt in die Mappe springe von der _
ich die Informationen beziehe
'wie kommt man an Pfad und Name der Mappe
strMappe = "C:\Users\Public\Test\Element_Daten.xlsx"
'Blattname ermitteln/vorgeben
varSheet = "Tabelle1" ' oder varSheet = 1
'und das zuvor geöffnete Objekt ausgewählt ist
'Mappe schreibgeschützt öffnen - falls Änderungen gemacht werden sollen, _
dann nicht schreibgeschützt öffnen
Set wkb = Application.Workbooks.Open(Filename:=strMappe, ReadOnly:=True)
Set wks = wkb.Worksheets(varSheet)
wks.Activate
Zeile = Application.Match(Element, wks.Range("A:A"), 0) 'Spalte für Suche  _
anpassen
If IsNumeric(Zeile) Then
Cells(Zeile, 1).Select
Else
MsgBox "Element nicht gefunden"
End If
End If
Else
MsgBox "Das Objekt wurde falsch zugewiesen oder Eintragung im Datenbestand fehlt!",  _
_
vbCritical, "Suche: " & Element
End If
End With
Exit Sub
MyErrorHandler:
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread