AW: Danke für die Rückmeldung
23.01.2004 10:16:36
urs
Hallo Roland
wie du siehst, habe ich den Thread wieder gefunden.
"Einfachheitshalber" habe ich den Code ins Forum gestellt.
Wo ich Fragen habe, habe ich ein Fragezeichen an den Zeilenanfang gestellt.
Die Dateien werden geöffnet.
Wie vermneide ich vom Programm her die Aktualisierung der geöffneten Dateien?
Warum wird der Dateiname und Kopfrechts nicht in die Zellen geschrieben? Fehlt es am
Datentransfer?
Die Subroutine Newxls hier nicht abgebildet, läuft eigentlich gut. Wie kann ich dort die
Frage ob eine vorhandene Datei überschrieben werden soll zum vornherein abschmettern?
Ich hoffe ich habe jetzt mein Problem deutlicher angegeben. Würdest Du mal reinschauen?
Vielen Dank Urs
--------------------------------
Sub Aenderungsindex()
'Workbooks.Add
Dim aRow As Integer, Rowb As Integer, Datei As String, Kopfr As String
Call Newxls ' Öffnet neue Arbeitsmappe
aRow = 3
Dim str As String, strPfad As String
strPfad = "R:\1_intern\Tabellen in Arbeit\Macro\Ordner_für_Serienmacros\"
str = Dir(strPfad & "*.xls")
While str <> ""
? Workbooks.Open (strPfad & str,[UpdateLinks:=0]) '????? Was ist hier Falsch?????
Call DateinamenUndKopfzeileAuslesen
ActiveWorkbook.Close SaveChanges:=False 'False weil nichts verändert werden soll
Windows("Auswertung_Indexvergleich.xls").Activate
? Cells(aRow, 1) = Datei '????? Was ist hier falsch es wird nichts eingetragen ?????
Cells(aRow, 2) = Kopfr
aRow = aRow + 1
str = Dir()
Wend
End Sub
'--------------------------------------------------------------------------------------------
Sub Newxls()
' Newxls öffnet eine Datei, beschriftet Kolonnen und Fusszeile und wird gespeichert
' Makro am 22.01.2004 von Urs erstellt
Workbooks.Add Template:="\\server17\stae$\Vorlagen\Arbeitsmappe.xlt"
Call Datum_Seiten_Datei
Range("A2").Select
ActiveCell.FormulaR1C1 = "Dateiname"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Änderungsindex"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Dateiname"
Range("D2").Select
ActiveCell.FormulaR1C1 = "Änderungsindex"
Columns("A:D").Select
Selection.ColumnWidth = 30
ActiveWorkbook.SaveAs Filename:= _
"R:\1_Intern\Tabellen in Arbeit\Macro\Auswertung_Indexvergleich.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
? ReadOnlyRecommended:=False, CreateBackup:=False '???? Ich will Überschreiben
End Sub
'---------------------------------------------------------------------------------------------
Sub DateinamenUndKopfzeileAuslesen()
Dim Datei As String, Kopfr As String
With ActiveWorkbook.Sheets(1)
Datei = ThisWorkbook.Name
Kopfr = .PageSetup.RightHeader
End With
End Sub