mehrere Excel Dateien gleichzeitig bearbeiten.
04.11.2004 04:06:29
Chris
ich hab hier einen Satz von ueber 100 Dateien von Kalkulationen, die identisch sind (ausser im Punkt Gewicht), in denen alle an der gleichen Stelle ein Fehler ist und die alle an der gleichen Stelle geaendert werden muessen.
Der Fehler ist bei allen Dateien im Feld "G 23". Dort muesste richtigerweise
"=G22/C8" stehen.
Ich hab das Forum mal durchsucht und folgenden Ansatz gefunden:
#####################
Sub Multipagesetup()
'Multi_Open
Dim arrFilenames As Variant
Dim wkbArr As Workbook
Dim wkbBasis As Workbook
Set wkbBasis = ActiveWorkbook
Selection:
' Zu öffnende Dateien erfragen
arrFilenames = Application.GetOpenFilename( _
"Exceldateien (*.xls), *.xls, Alle Dateien (*.*), *.*", 1, _
"Exceldateien auswählen...", MultiSelect:=True) ' Ausgewählte Dateien des Öffnen-Dialoges in Feld ablegen
If VarType(arrFilenames) = vbBoolean Then
If MsgBox("Sie haben keine Dateien ausgewählt. Möchten sie das Makro beenden?", vbYesNo, "Frage") = vbNo Then
GoTo Selection
Else
Set wbkBasis = Nothing
Exit
Sub
End If
End If
Application.ScreenUpdating = False
'Die vom Makro vorgenommenen Tätigkeiten
'bleiben zur Geschwidigkeitssteigerung unsichtbar
For i = 1 To UBound(arrFilenames) ' Durchläuft die Anzahl der Dateien
'Wenn Datei noch nicht geöffnet
If FileOpenYet(Dir$(arrFilenames(i))) = False Then
'dann öffnen
Workbooks.Open FileName:=arrFilenames(i)
Else
'oder aktivieren
Workbooks(Dir$(arrFilenames(i))).Activate
End If
Set wkbArr = ActiveWorkbook
'hier kommt dann der Code rein, der die ausgewählten Dateien
'betrifft. Die Ursprungsdatei ist über wbkBasis ansprechbar.
'wkbBasis.Worksheets(1).Cells(i, 1).Value = wkbArr.Worksheets(1).Range("F32").Value
'wkbBasis.Worksheets(1).Cells(i, 2) = wkbArr.Name
With wkbArr.Worksheets(1).PageSetup
' .PrintTitleRows = ""
' .PrintTitleColumns = ""
' .PrintArea = ""
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = ""
' .LeftFooter = ""
.CenterFooter = "&F"
' .RightFooter = ""
' .LeftMargin = Application.InchesToPoints(0.787401575)
' .RightMargin = Application.InchesToPoints(0.787401575)
' .TopMargin = Application.InchesToPoints(0.984251969)
' .BottomMargin = Application.InchesToPoints(0.984251969)
' .HeaderMargin = Application.InchesToPoints(0.4921259845)
' .FooterMargin = Application.InchesToPoints(0.4921259845)
' .PrintHeadings = False
' .PrintGridlines = False
' .PrintComments = xlPrintNoComments
' .PrintQuality = 600
' .CenterHorizontally = False
' .CenterVertically = False
' .Orientation = xlPortrait
' .Draft = False
' .PaperSize = xlPaperA4
' .FirstPageNumber = xlAutomatic
' .Order = xlDownThenOver
' .BlackAndWhite = False
' .Zoom = 100
End With
wkbArr.Close savechanges:=True 'Datei schließen
Set wkbArr = Nothing
Next i
Set wkbArr = Nothing
'Ursprüngliche Datei wieder aktivieren
wkbBasis.Activate
Set wkbBasis = Nothing 'Die Variable zurücksetzen
'und den Monitor aktivieren
Application.ScreenUpdating = True
End
Sub
Function FileOpenYet(FileName As String) As Boolean
'eine Funktion, die Prüft ob eine Datei schon geöffnet ist.
Dim s As String
On Error GoTo Nonexistent
s = Workbooks(FileName).Name
FileOpenYet = True
Exit
Function
Nonexistent:
FileOpenYet = False
End
Function
Ich hab nen relativ kurzfristigen Vorlagetermin.
Wenn mir jemand mit diesem Problem helfen wuerde, waere ich sehr dankbar!
Was muss ich oben abaendern, damit ich alle Dateien in wenig Zeit aendern kann, oder eventuell hat jemand fuer mich einen anderen Ansatz!
Danke und Gruss aus China!
Christian Scheidler
Anzeige