AW: immer noch aktuell "verknüpfung mit anderen"
19.09.2003 23:04:37
Norbert
versuch es mal mit folgendem Macro
Sub KW_Wechseln()
Dim p$
p = Range("B1").Value
ActiveCell.Formula = _
"=IF('C:\Dokumente und Einstellungen\haenselm.STUWE_DD\Desktop\Speiseplan2003\Mensen\[vmb.xls]" & (p) & ".KW'!R3C3:R7C3>0, 'C:\Dokumente und Einstellungen\haenselm.STUWE_DD\Desktop\Speiseplan2003\Mensen\[vmb.xls]" & (p) & ".KW'!R3C3:R7C3)"
End Sub
ich hatte gleiches Problem, mit INDIREKT() geht es nicht!!
Ich geb dir mal noch folgende Zeilen zum posten.
Mit diesm Macro kannst du ganze Verzeichnisse auslesen und in eine Datei importieren.
Sub Daten_einlesen()
Dim vFile As Variant
Dim Lvarfile As Single
Dim LvFile As Single
Dim p$, d$
'evtl. vorhandenen Bereich mit alten Daten markieren und löschen
Range("a2").Select
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(0, 0).Select
Selection.Delete
' Überschriften schreiben
Range("a1").Value = "Pfad"
Range("b1").Value = "Datei"
Range("c1").Value = "Inhalt aus Zelle a2"
Range("d1").Value = "Inhalt aus Zelle b2"
i = 1
With Application.FileSearch
.NewSearch
' Eingabe des Pfades der ausgelesen werden soll
'Bei fesgelegtem Pfad die beiden nächstenZeilen löschen und dritte Zeile wie folgt
'.LookIn = "C:\Eigene Dateien"
Dim Ordner$
Ordner = InputBox("Verzeichnis:", , "C:\Eigene Dateien")
.LookIn = Ordner
.Filename = "*.xls"
' Wenn Unterverzeichnisse nicht durchsucht werden sollen, .SearchSubFolders = False
.SearchSubFolders = True
If .Execute() > 0 Then
For Each varfile In .FoundFiles
vFile = varfile
vFile = Dir(vFile)
Lvarfile = Len(CStr(varfile))
LvFile = Len(CStr(vFile))
pathleft = Left(varfile, (Lvarfile - LvFile))
Cells(i + 1, 1).Value = pathleft
Cells(i + 1, 3).Select
p = "'" & pathleft & "["
d = vFile
'Formeln in Zellen schreiben
ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Activate
ActiveCell.Formula = "=" & (p) & (d) & "]Tabelle1'!$a$2"
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Formula = "=" & (p) & (d) & "]Tabelle1'!$b$2"
Cells(i + 1, 2).Value = vFile
i = i + 1
Next varfile
End If
End With
Range("A1").Select
End Sub
Ich hoffe es hilft
Gruß Norbert