Komplettes Makro
31.12.2006 17:04:23
Herby
Hallo Heinz,
anbei das komplette Makro:
Gehört in den SteuerelementeButton im Tabellenblatt "Artikeln":
Ich hab noch eine Kleinigkeit gegenüber den bisherigen Makro geändert.
Private Sub CommandButton1_Click()
Dim strErgebnis As String
Dim strPfad As String, strDatei As String, strPfadDatei As String
Dim ZelleA As String, ZelleR As String
Dim strSource As String
Dim LetzteZeile
' oder ActiveWorkbook.Path
strErgebnis = InputBox("Geben Sie die Nr. ein:", "SAP-Nummern", "33344 B2")
'strPfad = ThisWorkbook.Path & "\"
strPfad = "T:\Qs\Allgm.Lesen\PAs - nach SAP-Nummer" & "\"
strDatei = Left(strErgebnis, 5) & ".xls"
strPfadDatei = strPfad & strDatei
If strErgebnis = "" Then
MsgBox " Sie haben keinen Wert eingegeben !"
Exit Sub
ElseIf Dir(strPfadDatei) = "" Then
' MsgBox strPfadDatei
MsgBox "der eingegebene Wert " & strPfadDatei & " entspricht keinem Dateinamen im Verzeichnis !"
Exit Sub
End If
' Zelle berechnen
ZelleA = Mid(strErgebnis, 7)
ZelleR = Range(ZelleA).Address(ReferenceStyle:=xlR1C1)
strSource = "'" & strPfad & "[" & strDatei & "]Tabelle1'!" & ZelleR & ""
' Werte in Tab Artikeln eintragen
Select Case UCase(ZelleA)
Case "D8"
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & LetzteZeile).Value = xl4Value(strSource) 'zurückschreiben
Case "D11"
LetzteZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
Range("B" & LetzteZeile).Value = xl4Value(strSource) 'zurückschreiben
Case "L6"
LetzteZeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row + 1
Range("E" & LetzteZeile).Value = xl4Value(strSource) 'zurückschreiben
Case "L8"
LetzteZeile = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row + 1
Range("F" & LetzteZeile).Value = xl4Value(strSource) 'zurückschreiben
Case Else
MsgBox "Die Eingabe der Zelle " & ZelleA & " kann nicht zugeordnet werden !"
End Select
End Sub
und die Funktion für das Auslesen der geschlossenen Datein
Gehört in ein Modul:
Function xl4Value(strParam As String) As Variant
xl4Value = ExecuteExcel4Macro(strParam)
End Function
Viele Grüße
Herby