Variabler Laufwerkspfad
28.02.2013 15:29:40
Martin
Ich hatte vor kurzem ein Problem, bei dem mir Klaus M.vdT. schon gut weiter geholfen hat.
https://www.herber.de/forum/archiv/1296to1300/t1299960.htm
Jetzt stellt sich mir sofort ein weiteres "Problemchen":
Sub SprecheAlleBlaetterAn_Neu()
Dim wbOld As Workbook
Set wbOld = ActiveWorkbook
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim d As Variant
a = UserForm1.TextBox_A.Value
b = UserForm1.TextBox_B.Value
c = UserForm1.TextBox_ger.Value
d = UserForm1.TextBox_eng.Value
Call FileCheckOpen("C:Test\", "Datenbank.xlsm")
Application.ScreenUpdating = False
Call DatenEinfuegen(Sheets("Mengen"), a, b, c, d)
Call DatenEinfuegen(Sheets("Kosten"), a, b, c, d)
Call DatenEinfuegen(Sheets("Fläche"), a, b, c, d)
wbOld.Activate
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Sub DatenEinfuegen(wksMy As Worksheet, xa As Variant, xb As Variant, xc As Variant, xd As Variant)
Dim lRow As Long
Dim iColLast As Integer
With wksMy
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = xa
.Cells(lRow, 2).Value = xb
.Cells(lRow, 3).Value = xc
.Cells(lRow, 4).Value = xd
.AutoFilter.Sort.SortFields.Clear
.AutoFilter.Sort.SortFields.Add Key _
:=.Range("A2:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key _
:=.Range("B2:B" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With .AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
iColLast = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 5), .Cells(2, iColLast)).Copy
.Range(.Cells(3, 5), .Cells(lRow, iColLast)).PasteSpecial
End With
End Sub Sub FileCheckOpen(sPath As String, sFile As String)
sPath = sPath & "/" & sFile
If WkbExists(sFile) = False Then
If Dir(sPath) = "" Then
MsgBox "File " & sPath & " not found!"
Else
Workbooks.Open sPath, UpdateLinks:=False
End If
Else
Workbooks(sFile).Activate
End If
End Sub
Private Function WkbExists(sFile As String) As Boolean
'returns FALSE if workbook does not exist
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
Zur kurzen Erläuterung:Es werden über ein UserForm in Workbook1 4 TextBoxes ausgefüllt. Beim Bestätigen des OK buttons des UserForms wird das Makro SprecheAlleBlaetterAn_Neu gestartet. Daraufhin öffnet sich Workbook2, und in alle Tabellenblätter werden die Werte der TextBoxes geschrieben.
Funktioniert alles Prima. Jetzt ist es aber so, dass beim verschieben / kopieren der beiden Workbooks in ein anderes Verzeichnis das ganze unbrauchbar wird.
Kann man Laufwerkspfäde variabel gestalten? Dass ich z.B. im Workbook1 in einem Tabellenblatt eine Zeile reserviere, in der der Anwender den Pfad vom Workbook2 angeben muss. Über ein Range wird dieser Wert dann abgefragt und oben ins Call Filecheckopen(...) geschrieben. Habe es eben selber versucht mit
Path = Worksheets("Tabelle1").Range("C3").Value
und dann oben ins Call Filecheckopen("Path", "Datenbank.xlsm")
dann wird jedoch beim Erniedrigen des OK Buttons (logischerweise) die Fehlermeldung ausgegeben 'Path/Datenbank.xlsm' existiert nicht.
Hat jemand eine Idee das Problem zu lösen?
Liebe Grüße
Martin