Re: Tabellen - noch offen, da
17.02.2003 15:41:55
steffen
Okay, ich werds ja sehen. Zum allgemeinem Verständnis füge ich mal eben den Code ein, der da wäre:Sub start()
k = Range("A9")
na = Range("A6")
Workbooks.Add
ActiveWorkbook.SaveAs (k)
ActiveSheet.name = "Start"
steuerung (na)
End Sub
Sub steuerung(na)
dirna = "d:\grace_offline\gr1_off\program\"
Sheets.Add
ActiveSheet.name = 1
s = 1
t = 3
n = 10
k = 2
s1 = 1
flag1 = 0
Call einlesen(dirna, na)
Do While s > 0
Do While Cells(t, 1) <> "" Or Cells(t + 1, 1) <> ""
Do While Cells(t, s1) <> ""
If Right(Cells(t, s1), 3) = "ctl" Then
nam = Namen(Cells(t, s1))
Sheets("Start").Hyperlinks.Add Anchor:=Sheets("Start").Cells(n, k + 1), Address:= _
dirna & nam, TextToDisplay:=nam
Sheets("Start").Cells(n, k) = "-->"
Range("Z1") = t
Sheets.Add
s = s + 1
ActiveSheet.name = s
On Error GoTo 1
Call einlesen(dirna, nam)
t = 3
k = k + 2
s1 = 0
End If
s1 = s1 + 1
Loop
s1 = 1
t = t + 1
Loop
Application.DisplayAlerts = False
If s > 0 Then Sheets("" & (s)).Delete
s = s - 1
k = k - 2
If s > 0 Then Sheets("" & s).Activate
If flag1 = 0 Then
n = n + 1
Else
flag1 = 0
End If
t = Range("Z1") + 1
Application.DisplayAlerts = True
ActiveWorkbook.Save
Loop
Exit Sub
1: On Error GoTo 0
Sheets("Start").Cells(n, k + 1).Interior.ColorIndex = 3
n = n + 1
flag1 = 1
Resume Next
End Sub
Sub einlesen(dirna, na)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & dirna & na, _
Destination:=Range("A3"))
.name = Left(na, Len(na) - 4)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.Refresh BackgroundQuery:=False
End With
t = 3
Do While Cells(t, 1) <> "" Or Cells(t + 1, 1) <> ""
If Left(Cells(t, 1), 1) = "*" Then
Rows(t).Delete
t = t - 1
End If
t = t + 1
Loop
End Sub
Function Namen(name)
s1 = 1
Do While s1 < Len(name)
k = Mid(name, s1, 1)
If s1 < Len(name) And k = "\" Then
Namen = Right(name, Len(name) - s1)
Exit Function
End If
s1 = s1 + 1
Loop
Namen = name
End Function
Vorsicht, es sind drei Subroutinen und eine Funktion. Okay, das Problem ist folgendes:
Scheinbar werden nicht alle Tabellenblätter gelöscht, obwohl die angeblich gelöschten Blätter im reinen Excel nicht mehr zu sehen sind, werden sie im ProjektExplorer von VB noch angezeigt. Dabei wird "TabelleXYZ (F)" angezeigt. XYZ steht für die fortlaufende Nummer beim Einfügen von neuen Blättern, F für den von mir vergebenen Namen. Da sich die Hauptroutine immer wieder eine Hilfsroutine ruft, wird der von mir vergebene Name, welcher auch für die Tiefe der Links steht, natürlich mehrfach innerhalb der Analyse vergeben. Vielleicht hängt es damit zusammen. Keine Ahnung, wie und ob man das umgehen kann.
Jetzt bin ich auf konstruktive Antworten ja gespannt.
Servus.