Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
508to512
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
508to512
508to512
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
mehrere Excel Dateien gleichzeitig bearbeiten.
04.11.2004 04:06:29
Chris
Hallo,
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

		

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mehrere Excel Dateien gleichzeitig bearbeiten.
Harald
Hallo Christian,
wie wär's damit:
Option Explicit

Sub test()
Const folderspec = "c:\temp" 'Hier das Verzeichnis, in dem die 100 XLS Dateien liegen - aber keine anderen XLS als die zu Ändernden!
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
If UCase(Right(f1, 3)) = "XLS" Then 'Excel File gefunden
Call ChangeCell(folderspec, f1.Name)
End If
Next
End Sub


Sub ChangeCell(folder As String, file As String)
Workbooks.Open Filename:=folder & "\" & file
Range("G23").Select
ActiveCell.Formula = "=G22/C8"
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Gruß Harald
Anzeige
AW: mehrere Excel Dateien gleichzeitig bearbeiten.
Chris
vielen , vielen Dank!
Ich hab in meiner Not die Dinger zum Grossteil schon per Hand editiert, aber fuer den Rest hat es wunderbar geklappt!
Danke nochmal :-)

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige