Microsoft Excel

Herbers Excel/VBA-Archiv

Anwendungs- oder objektdefinierter Fehler

Betrifft: Anwendungs- oder objektdefinierter Fehler von: Peter
Geschrieben am: 18.07.2007 14:29:55

Liebes Forum

Mit meinem Makro führe ich die Daten verchiedener Tabellen zusammen. Er fügt in einer immer gleichlautenden Tabelle von Dateien in einer zu definierenden Spalte (hier K) vorgängig einen Identifikationsstring ein (ein paar Stellen des jeweiligen Dateinamens).
Nachfolgende Codezeile gibt mir die im Betreff erwähnte Fehlermeldung.
WB.Worksheets(TabName).Range(Cells(1, xspalteID), Cells(lr, xspalteID)) = strAktiveDatei. Interessant ist, dass der Fehler nicht bei jeder Datei, aus der Daten zu übernehme sind, vorkommt. Keine der Dateien ist gesperrt.

Wenn ich jedoch die einzelnen Komponenten anschaue, sehe ich keinen Fehler.
Ich habe WB.Name mit Debug.Print ausgewertet, das gibt mir den Dateinamen zurück.
Wenn ich mit der Maus über TabName fahre, erhalte ich den Tabellennamen
der Range ergibt K1:K?? (hier 203)
mit strAktiveDatei sollte eine String, hier "875041" in den Bereich K1:K203 geschrieben werden

Hat jemand eine Idee, was hier falsch sein könnte?

Danke für eine Rückmeldung

Peter

Hier ist noch der ganze Code:

Option Explicit

Sub Dateien()
  Const TabZiel = "Daten" ' Blatt in dem die Daten ankommen sollen
  Dim TabName As String
  Dim strVerz As String
  Dim strDatei As String, strAktiveDatei As String
  Dim lngZ As Long, i As Long, lr As Long, lrZiel As Long, xSpalteNr As Long, lLäName As Long,  _
xAnzahlID As Long, xspalteID As Long, xItem2 As Long
  Dim WBAktiv As Workbook
  Dim ShTab As Worksheet
  Dim WB As Workbook
  Set WBAktiv = ActiveWorkbook
  Set ShTab = WBAktiv.Sheets("Dateien")
  TabName = Range("CTab").Value
  xSpalteNr = Range("xSpalteNr").Value
  xspalteID = Range("xSpalteID").Value
  xAnzahlID = Range("xAnzahlID").Value
  xItem2 = Range("xitem2").Value
  strVerz = ActiveWorkbook.Path & "\" 'Backslash am Ende nicht vergessen!
  
  ShTab.Columns(1).ClearContents
 WBAktiv.Sheets(TabZiel).Cells.ClearContents
  Application.ScreenUpdating = False
  
  'Verzeichnis auslesen
  strDatei = Dir(strVerz & "*.xls")
  'Debug.Print strDatei
  Do Until strDatei = ""
    If UCase(strVerz & strDatei) <> UCase(ActiveWorkbook.FullName) Then
        lngZ = lngZ + 1
        ShTab.Cells(lngZ, 1) = strDatei
    End If
        strDatei = Dir()
  Loop
  
  'Dateien nacheinander öffnen und Daten übertragen
  For i = 1 To lngZ
    Set WB = Workbooks.Open(Filename:=strVerz & ShTab.Cells(i, 1))
 
    lr = WB.Worksheets(TabName).Cells(Rows.Count, xSpalteNr).End(xlUp).Row   'Spalte wird über  _
Dropdownmenu in Worksheet abgefragt
    strAktiveDatei = ActiveWorkbook.Name
   lLäName = Len(strAktiveDatei)
   strAktiveDatei = Left(strAktiveDatei, lLäName - 4)
  strAktiveDatei = Left(strAktiveDatei, xAnzahlID)
    'Wenn Spalte nicht leer dann...
    If lr > 0 Then
        '...Wert in Blatt [TabZiel] eintragen
        lrZiel = WBAktiv.Sheets(TabZiel).Cells(Rows.Count, xSpalteNr).End(xlUp).Row + 1   ' _
Spalte wird über Dropdownmenu in Worksheet abgefragt
        
    Select Case i
    Case 1
   ' WB.Worksheets(TabName).Rows("1:" & lr).Copy Destination:=WBAktiv.Sheets(TabZiel).Rows( _
lrZiel)
  'mit voriger Zeile würde der ganze Inhalt übertragen
 WB.Worksheets(TabName).Range(Cells(1, xspalteID), Cells(lr, xspalteID)) = strAktiveDatei
  WB.Worksheets(TabName).Rows("1:" & lr).Copy
  With WBAktiv.Sheets(TabZiel).Rows(lrZiel - 1)
  .PasteSpecial Paste:=xlValues   'Werte
  '.PasteSpecial Paste:=xlFormats      ' Formate
  End With
  Application.CutCopyMode = False
    Case Else
    
   ' WB.Worksheets(TabName).Rows("2:" & lr).Copy Destination:=WBAktiv.Sheets(TabZiel).Rows( _
lrZiel)
    'mit voriger Zeile würde der ganze Inhalt übertragen
    'Debug.Print WB.Name
    
BEI NACHFOLGENDER ZEILE TAUCHT DIE FEHLERMELDUNG AUF:

     WB.Worksheets(TabName).Range(Cells(1, xspalteID), Cells(lr, xspalteID)) = strAktiveDatei




   WB.Worksheets(TabName).Rows(xItem2 & ":" & lr).Copy   'im Eingabebereich kann angegeben  _
werden, ab welcher Zeile die Daten
                                                         'ab Datei 2 übernehmen (z.B. Kopfzeile  _
nur in erster Datei, dann ab Zeile 2)
   
   
  With WBAktiv.Sheets(TabZiel).Rows(lrZiel)
  .PasteSpecial Paste:=xlValues   'Werte
   '.PasteSpecial Paste:=xlFormats      ' Formate
  End With
  Application.CutCopyMode = False
    End Select
    End If
    'Mappe (ohne speichern) schließen
    WB.Close False
  Next i
  Application.ScreenUpdating = True
End Sub


  

Betrifft: AW: Anwendungs- oder objektdefinierter Fehler von: Renee
Geschrieben am: 18.07.2007 15:18:22

Mazwara Peter,

Die Range kann nicht bestimmt werden, weil Cells(1, xspalteID), Cells(lr, xspalteID) keinen Objektbezeichner haben. Es müsste heissen

WB.Worksheets(TabName).Range(WB.Worksheets(TabName).Cells(1, xspalteID), _
                             WB.Worksheets(TabName).Cells(lr, xspalteID)) = strAktiveDatei



Greetz Renee


  

Betrifft: AW: Anwendungs- oder objektdefinierter Fehler von: Peter
Geschrieben am: 18.07.2007 15:31:19

Hallo Renée
Es läuft wie geschiert!! Vielen Dank.

Kannst du dir vorstellen, weshalb das dann trotzdem zwischendurch funktioniert hat? (Oder muss ich diese Frage Mr. Gates stellen ...)


  

Betrifft: AW: Anwendungs- oder objektdefinierter Fehler von: Renee
Geschrieben am: 18.07.2007 15:49:52

Hi Peter,

Ja das kann ich.
Wenn zufällig das richtige Tabellenblatt das Aktive war.

Greetz Renee

P.S. Ich glaube kaum, dass Billy-Boy das gewusst hätte. Zudem muss er seine Buchhaltung eh mit einem externen Programm machen, denn 15 Stellen Genauigkeit von Excel genügen nicht um seine Dollars zu verwalten.


  

Betrifft: AW: Anwendungs- oder objektdefinierter Fehler von: Peter
Geschrieben am: 18.07.2007 16:29:11

Hallo Renée
So ist es nun auch für mich nachvollziehbar. Vielen Dank.

Und das PS zu Billy hat auch etwas für sich.

Gruss, Peter


 

Beiträge aus den Excel-Beispielen zum Thema "Anwendungs- oder objektdefinierter Fehler"