Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Formel in mehrere Dateien eintragen lassen



Excel-Version: 8.0 (Office 97)

Betrifft: Formel in mehrere Dateien eintragen lassen
von: MikeS
Geschrieben am: 07.06.2002 - 08:16:22

Hallo Leute,

habe nachfolgendes Problem:

In meinem Hauptordner z.B. (C:\Eigene Dateien\Hauptordner\) gibt es weitere
Unterordner, die jede Menge Excel-Dateien enthalten.

Nun möchte ich alle xls.-Dateien, die im Hauptordner und den Unterordnern gefunden werden,
nacheinander öffnen und in die Zelle B2 eine Formel eintragen lassen.

Dann soll die jeweilige Datei gespeichert / geschlossen werden und die nächste Datei
bearbeitet werden.

Jede Datei hat die gleiche Struktur.

Kann man das vielleicht irgendwie realisieren???

Vielen Dank, ciao MikeS

  

Moment
von: andré
Geschrieben am: 07.06.2002 - 08:41:01

-

  

Re: Moment
von: andré
Geschrieben am: 07.06.2002 - 08:44:22


sowas änliches hab ich auch grad gebaut, nur das ich die dateien dann etwas komplizierter duchsuche. (das steht zwischen den kommentarzeilen) aber die suchroutine (supercool!!!) kannst du ja verwenden. es ginge garantiert auch einfacher mit appication.filesearch aber ich habs so gemacht dann kann ichs später vielleicht auch mal in VB einsetzen.

viel Spaß


Option Explicit

Dim Such As String
Dim Pfad As String
Private Type DB
Pfad As String
Indx As Long
Ebene As Integer
End Type
Dim FolderDB() As DB
Dim Indx As Long 'zähler für speipfad
Dim Ebene As Integer 'zähler für Ordnerebene
Dim i As Long
Dim LstEin As String

Dim ActSh As Worksheet
Dim ActRe As Range
Dim TmpStr As String
Dim Msg

Dim Suchtxt As String
Dim Ersetztxt As String

Private Sub cmd_Click()

Msg = MsgBox("Prozess für den Ordner:" & Chr(13) + Chr(10) & txt_Pfad.Text & Chr(13) + Chr(10) & "starten?", 4404, "Prozess starten")

If Msg = 7 Then
Exit Sub
End If

lst.Clear
Erase FolderDB()
ReDim FolderDB(0)
Indx = 0
Ebene = 0

Suchtxt = txt_suchtxt.Text
Ersetztxt = txt_ersetztxt.Text

FolderDB(0).Pfad = txt_Pfad.Text
FolderDB(0).Indx = 0
FolderDB(0).Ebene = 0

While FolderDB(0).Pfad <> ""

Pfad = FolderDB(0).Pfad
Indx = FolderDB(0).Indx
Ebene = FolderDB(0).Ebene

Such = Dir(Pfad, vbDirectory)
While Such <> ""
If Such <> ".." And Such <> "." Then
If GetAttr(Pfad & Such) = 16 Then
'wenn ordner
LstEin = ""
For i = 0 To Ebene - 1
LstEin = LstEin & "| "
Next i
LstEin = LstEin & "|-|" & Such
lst.AddItem LstEin, Indx
For i = 1 To UBound(FolderDB())
If FolderDB(i).Indx > Indx Then
FolderDB(i).Indx = FolderDB(i).Indx + 1
End If
Next i
ReDim Preserve FolderDB(UBound(FolderDB()) + 1)

FolderDB(UBound(FolderDB())).Pfad = Pfad & Such & "\"
FolderDB(UBound(FolderDB())).Indx = Indx + 1
FolderDB(UBound(FolderDB())).Ebene = Ebene + 1

Indx = Indx + 1
Else
'wenn datei

'-----------------------------------------------------datei bearbeiten-----------------------------
If InStr(Such, ".xls") Then

Application.ScreenUpdating = False
Workbooks.Open Filename:=Pfad & Such, UpdateLinks:=0
Application.DisplayAlerts = False

For Each ActSh In Worksheets

ActSh.Activate
ActiveSheet.Unprotect ("qmp")

For Each ActRe In ActSh.UsedRange.Cells
ActRe.Activate
If ActRe.HasFormula Then
If InStr(ActRe.Formula, Suchtxt) Then
ActRe.Formula = Replace(ActRe.Formula, Suchtxt, Ersetztxt)
End If
End If
Next ActRe

ActiveSheet.Protect "qmp", DrawingObjects:=True, Contents:=True, Scenarios:=True

Next ActSh

Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True

End If
'-----------------------------------------------------datei bearbeiten ende-----------------------------

LstEin = ""
For i = 0 To Ebene - 1
LstEin = LstEin & "| "
Next i
LstEin = LstEin & "|-" & Such
lst.AddItem LstEin, Indx
For i = 1 To UBound(FolderDB())
If FolderDB(i).Indx > Indx Then
FolderDB(i).Indx = FolderDB(i).Indx + 1
End If
Next i

Indx = Indx + 1

End If
End If
Such = Dir
Wend

For i = 1 To UBound(FolderDB())
FolderDB(i - 1).Pfad = FolderDB(i).Pfad
FolderDB(i - 1).Indx = FolderDB(i).Indx
FolderDB(i - 1).Ebene = FolderDB(i).Ebene
Next i

If UBound(FolderDB()) > 0 Then
ReDim Preserve FolderDB(UBound(FolderDB()) - 1)
Else
FolderDB(0).Pfad = ""
End If
Wend

MsgBox "erfolgreich abgeschlossen", , "Meldung"

End Sub

  

Re: Moment
von: andré
Geschrieben am: 07.06.2002 - 08:47:48

vielleicht noch etwas quelltexterläuterung:

die ganze ordnerstruktur die durchsucht wird, wird dann auch gleichzeitig in eine listbox mit dem namen "lst" eingetragen. der pfad der durchsucht wird wird über ein textfeld mit dem namen "txt_pfad" eingegeben.

mfg andré

  

Hilfe nötig
von: MikeS
Geschrieben am: 07.06.2002 - 09:00:10

Hallo Andre`,

vielen Dank für Deine langen Code.

Den muß ich mir erstmal reinziehen.

Nun muß ich noch sagen, daß ich zwar nicht mehr ein blutiger Anfänger in Sachen VBA bin, aber doch noch in den "Anfängen" stecke.

So wird es bestimmt zu Problemen kommen, den Code für mich anzupassen.

Ich probier`s mal aus und melde mich später nochmal.

Ciao MikeS


  

Re: Hilfe nötig
von: andré
Geschrieben am: 07.06.2002 - 09:10:27

wenn du noch den PAP dazu brauchst den hab ich auch noch da! in einer Visio datei ;)

  

Re: Hilfe nötig
von: MikeS
Geschrieben am: 07.06.2002 - 09:14:32

Hallo Andre`,

was ist ein PAP???

Ciao MikeS


  

Programmablaufplan
von: andré
Geschrieben am: 07.06.2002 - 09:18:47

da ist das ganze programm (der ablauf) grafisch aufgezeichnet

  

Re: Programmablaufplan
von: MikeS
Geschrieben am: 07.06.2002 - 09:20:57

Hi Andre`,

dann schick mir bitte das Ding doch per mail.

Danke MikeS


  

kannst du visio dateien öffnen?
von: andré
Geschrieben am: 07.06.2002 - 09:22:29


  

Käme auf einen Versuch an.
von: MikeS
Geschrieben am: 07.06.2002 - 09:23:44


  

habs ihn dir geschickt, aber als gif
von: andré
Geschrieben am: 07.06.2002 - 09:28:41


 

Beiträge aus den Excel-Beispielen zum Thema "Formel in mehrere Dateien eintragen lassen"