Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

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

Hallo Franz, Hallo mari....... | Herbers Excel-Forum


Betrifft: Hallo Franz, Hallo mari....... von: Volker
Geschrieben am: 02.02.2010 21:08:42

Hallo FRanz, Hallo mari,

leider weiss ich nicht wie ich euch erreichen kann. Mit meinem Problem bin ich leider immer noch nicht weitergekommen und der Beitrag ist anders nicht mehr von mir "anschreibebar".
Meine Fehler ist 438. Franz wo muss ich denn den Code reinkopieren?

https://www.herber.de/bbs/user/67566.txt

Meine Excel Veriosn ist 2000
gruss Volker

  

Betrifft: AW: Hallo Franz, Hallo mari....... von: fcs
Geschrieben am: 03.02.2010 09:26:11

Hallo Volker,

ich hab nochmals verschiedene Checks gemacht auch unter Excel 2003. Den Fehler 438 konnte ich nicht reproduzieren.

Ein paar andere Situationen führten aber ebenfalls zu Fehlermeldungen, z.B.:
- Datei mit Makro ist im gewählten Verzeichnis,
- Keine Excel-Datei im gewählten Verzeichnis
- Auswahl des Verzeichnisses abgebrochen.

Ich in diese Richtung hab ich nochmals Anpassungen gemacht.

Gruß
Franz
https://www.herber.de/bbs/user/67710.xls


  

Betrifft: AW: Hallo Franz, Hallo mari....... von: Volker
Geschrieben am: 03.02.2010 17:24:47

Hallo Franz....
ich gölaube ich bin wohl zu blöd.
Ich bekomme immer wieder die gleich Fehlermedungen und abbrüche.

https://www.herber.de/bbs/user/67738.doc

Kannst du noch mal gucken?
Gruss Volker


  

Betrifft: AW: Hallo Franz, Hallo mari....... von: fcs
Geschrieben am: 04.02.2010 05:30:28

Hallo Volker,

es kann sein, das
Application.FileDialog(msoFolderPicker)
in VBA von Excel 2000 noch nicht integriert ist.

Hier eine Variante die über einen Dateiauswahldialog den Ordner ermittelt.
Die Datei wird nicht geöffnet, sondern "nur" der im Dialog gewählte Ordner ausgewertet.
Diese Methode funktioniert meines Wissens in allen älteren Excel-VBA-Versionen

Gruß
Franz

Sub Tabellenblattauslesen()
  Dim sVerzeichnis$, sDatei$, StatusCalc As Long, ZeileZ As Long
  Dim wbZiel As Workbook, wbQuelle As Workbook, oQuelle As Object, intI As Integer
  Dim wksZiel As Worksheet
  Dim sVerzAktuell As String, vAuswahl
  On Error GoTo Fehler
  'Suchverzeichnis auswahlen
  StatusCalc = Application.Calculation
  sVerzAktuell = VBA.CurDir 'Verzeichnis merken
  vAuswahl = Application.GetOpenFilename(FileFilter:="Excel (*.xl*),*.xl*", _
    Title:="Bitte im gewünschten Ordner eine Exceldatei wählen und Öffnen")
    If vAuswahl <> False Then
      sVerzeichnis = VBA.CurDir
      sDatei = Dir(sVerzeichnis & Application.PathSeparator & "*.xl*")
      If sDatei <> "" Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        Do Until sDatei = ""
          Application.StatusBar = "Bearbeite Datei " & sDatei
          If LCase(sDatei) = LCase(ThisWorkbook.Name) Then
            Set wbQuelle = ThisWorkbook
          Else
            Set wbQuelle = Workbooks.Open( _
              Filename:=sVerzeichnis & Application.PathSeparator & sDatei, _
              ReadOnly:=True)
          End If
          If wksZiel Is Nothing Then
            'neue Datei mit einem Tabellenblatt für Ergebnisdaten erstellen
            Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
            'Zieltabellenblatt Objektvariable zuweisen
            Set wksZiel = wbZiel.Worksheets(1)
            ZeileZ = 1
            With wksZiel
              'Titelzeile ausfüllen
              .Cells(ZeileZ, 3) = "Dateiname"
              .Cells(ZeileZ, 4) = "Blatt-Nr"
              .Cells(ZeileZ, 5) = "Blatt-Name"
            End With
            Range("A2").Select
            ActiveWindow.FreezePanes = True
          End If
          With wksZiel
            intI = 0 'Blattzähler zurücksetzen
            For Each oQuelle In wbQuelle.Sheets
              intI = intI + 1
              ZeileZ = ZeileZ + 1
              .Cells(ZeileZ, 3) = sDatei
              .Cells(ZeileZ, 4) = intI
              .Cells(ZeileZ, 5) = oQuelle.Name
            Next
          End With
          wbQuelle.Close savechanges:=False
          Set wbQuelle = Nothing
NextDatei:
          sDatei = Dir
        Loop
        Application.ScreenUpdating = True
      End If
      If wksZiel Is Nothing Then
        MsgBox "Keine Excel-Dateien im Verzeichnis """ & sVerzeichnis _
          & """ gefunden", vbInformation + vbOKOnly, _
          "Arbeitsmappen-Tabellen-Liste"
      Else
        MsgBox "Alle Dateien im Verzeichnis """ & sVerzeichnis _
          & """ ausgewertet", vbInformation + vbOKOnly, _
          "Arbeitsmappen-Tabellen-Liste"
        wksZiel.Columns.AutoFit
      End If
   End If
  If VBA.CurDir <> sVerzAktuell Then VBA.ChDir sVerzAktuell
  Err.Clear
Fehler:
  With Err
    Select Case .Number
      Case 0 'alles OK
      Case Else
        Application.ScreenUpdating = True
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
        If Not wbQuelle Is Nothing Then wbQuelle.Close savechanges:=False
    End Select
  End With
  Set wbZiel = Nothing: Set wksZiel = Nothing: Set wbQuelle = Nothing
  Application.ScreenUpdating = True
  If StatusCalc <> Application.Calculation Then Application.Calculation = StatusCalc
  Application.EnableEvents = True
  Application.StatusBar = False
End Sub



  

Betrifft: AW: Hallo Franz, Hallo mari....... von: Volker
Geschrieben am: 04.02.2010 20:01:36

Hallo Franz, KLASSE. der Code läuft jetzt super.
Danke dir mal wieder!!!
Habe alles so wie ich es wollte. Du bist Suoer.
Bis bald mal wieder-
Gruss Volker