AW: Hilfe bei einem Makro
22.07.2015 22:50:28
Michael
Hallo Frank,
ich habe Hr. Herbers Code etwas angepaßt. Zum Nachbasteln eines Formulars habe ich keinen Bock, also rufe ich die Funktion externerWert einfach in der Sub Meins auf, in der meine Testwerte auch drinstehen.
Herbers originale Sub DateiOeffnen habe ich als Funktion externerWert gestaltet, so daß sie variabel auch an anderer Stelle einsetzen kannst: sie erhält als Übergabeparameter den Dateinamen und -Pfad, den Namen des Blattes und sogar die Position der auszulesenden Zelle.
Naja, es ist zu heiß für "eleganten" Code, hier mit heißer Nadel gestrickt:
Option Explicit
Sub Meins()
Dim wert As String
wert = externerWert("Datei_Oeffnen_Datei.xlsx", ThisWorkbook.Path, "Tabelle1", "A5")
MsgBox wert
End Sub
Sub Deins()
Dim wert As String
wert = externerWert("2. Bundesliga 2014 - 2015.xlsm", _
"O:\Meine Dateien - neu\Fußball\Saison 2014 - 2015\2. Bundesliga 2014-2015", _
"Tabellen", "E631")
With frmRelegation
TextBox6 = wert
End With
End Sub
Public Function externerWert(ByVal sFile As String, ByVal sPath As String, _
ByVal tabName As String, ByVal rng As String) As String
sPath = sPath & "\" & sFile
If WkbExists(sFile) = False Then
If Dir(sPath) = "" Then
externerWert = "Datei " & sPath & " wurde nicht gefunden!"
Else
Workbooks.Open sPath
externerWert = Sheets(tabName).Range(rng)
ActiveWindow.Close
End If
Else
Workbooks(sFile).Activate
externerWert = Sheets(tabName).Range(rng)
ActiveWindow.Close
End If
End Function
Private Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function
Happy Exceling,
Michael