✔ Speicherüberlauf mit Excel2000

dPo2000 · 14. August 2002

Hallo,

ich habe ein Makro geschrieben und nach einer Weile beendet sich das Makro mit der Fehlermeldung: "Laufzeitfehler 1004 - die Copy Mehtode konnte nicht ausgeführt werden" ! Im Wesentlichen kopiere ich nur Tabellenblätter und schreibe Werte einer Datenbank hinein. Wir haben schon rausgefunden das Excel irgendwie Probleme kriegt mit seinem Puffer beim Kopieren. Nun meine Frage: Ist es möglich den Speicher irgendwie "programmiertechnisch" zu leeren ? Oder muß ich mein Makro dem Bug anpassen ???

Vielen Dank für Eure Antworten !

MfG
dPo

P.S.: @ Moderator: Falls ich in diesem Forum falsch liegen sollte mit meiner Frage verschieb den Thread bitte ins VB Forum. Ich dachte nur da das ein Excel (und kein Programmier) Bug ist, gehört er hierher - Danke !

Kosh · 19. August 2002

Hast du irgendwelche Schleifen im Makro? Wenn ja check mal ob das ne Endlosschleife ist. Ansonsten poste doch mal den Quellcode wenn er nicht zu groß ist

dPo2000 · 19. August 2002

Original geschrieben von Kosh
Hast du irgendwelche Schleifen im Makro? Wenn ja check mal ob das ne Endlosschleife ist. Ansonsten poste doch mal den Quellcode wenn er nicht zu groß ist

nee - keine endlosschleife ;P

PHP:

Sub AccessDatenAbfragen()
Dim db As ADODB.Connection 'Datenbank-
Dim rs As ADODB.Recordset  'variablen
Dim rs2 As ADODB.Recordset
Dim strCon As String       'deklarieren

Dim gruppe As String       'msgboxvariable deklarieren
Dim x As String            'leeren Vergleichsstring deklarieren
Dim y As String            'veränderten DB String deklarieren

'Application.ScreenUpdating = False

    Set db = New ADODB.Connection
    
    Set rs2 = New ADODB.Recordset
    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\test.mdb;Persist Security Info=False"
    db.Open strCon
    rs2.CursorType = adOpenKeyset

    rs2.Open "SELECT A_Result.Member_Group FROM A_Result GROUP BY A_Result.Member_Group ORDER BY A_Result.Member_Group DESC;", db
    


Do While Not rs2.EOF And rs2.Fields("Member_Group") <> ""
UserForm1.ComboBox1.AddItem (rs2.Fields("Member_Group"))
rs2.MoveNext
Loop
UserForm1.Show

    rs2.Close                'RecordSet schließen
    db.Close                'Datenbank schließen

Set rs2 = Nothing            'Variablen auf Null setzen
Set db = Nothing

gruppe = UserForm1.ComboBox1.Value

Unload UserForm1

frage = MsgBox("Gruppe: " & gruppe, vbQuestion + vbYesNo, "Ist diese Gruppe richtig ?")  'zur Sicherheit wird die Gruppe gemeldet und abgefragt
If frage = 7 Then Exit Sub                                                               'falls "NEIN" geklickt wurde, wird abgebrochen
    
 
Range("C11").Value = gruppe
x = ""                                      'x wird für den Vergleich auf Null gesetzt
i = 0                                       'der Durchlaufzähler wird auf 0 gesetzt
zehn = 2                                    'der
psychonamen = 2
gesamtnamen = 3
z = 1

Set db = New ADODB.Connection
Set rs = New ADODB.Recordset
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\test.mdb;Persist Security Info=False"
db.Open strCon
rs.CursorType = adOpenKeyset
    rs.Open "SELECT A_Result.Member_Group, A_Result.Participant, A_Session.Session_Name, Max(A_Result.Total_Score) AS [Max von Total_Score], A_Result.Max_Score FROM A_Session INNER JOIN A_Result ON A_Session.Session_Index = A_Result.Session_Index WHERE (((A_Result.Status) = 2 Or (A_Result.Status) = 3) And ((A_Result.Still_Going) = False) And ((A_Result.When_Finished) Is Not Null)) GROUP BY A_Result.Member_Group, A_Result.Participant, A_Session.Session_Name, A_Result.Max_Score HAVING (((A_Result.Member_Group)='" & gruppe & "'));", db      'der RecordSet wird mit der SQL Abfrage geöffnet

Do While Not rs.EOF

y = rs.Fields("Participant")                'das Feld "Participant" wird an y übergeben
y = Trim(y)                                 '"y" wird getrimmt (keine leerzeichen)
y = LCase(y)                                '"y" wird in lowercase umgewandelt


If x <> y Then                            'wenn x<>y
    
    psychonamen = psychonamen + 1
    gesamtnamen = gesamtnamen + 1
    header = header + 1
    zehn = zehn + 1
    i = i + 1
    
    Sheets("Tabelle1").Copy After:=Sheets(i)                'angelegt
    ActiveSheet.Name = y
    Range("C9").Value = y                          'wird eine
    
    Range("A1").Value = i
    
    Range("D20").Formula = "=psycho!B" & zehn & ""
    Range("D61").Formula = "=psycho!C" & zehn & ""
    Range("D62").Formula = "=psycho!D" & zehn & ""
    Range("D85").Formula = "=psycho!E" & zehn & ""
    Range("D86").Formula = "=psycho!F" & zehn & ""
    Range("D135").Formula = "=psycho!H" & zehn & ""
    
    Sheets("Gesamtauswertung").Activate
    Range("B" & gesamtnamen & "").Formula = "='" & y & "'!D63"
    Range("C" & gesamtnamen & "").Formula = "='" & y & "'!D88"
    Range("D" & gesamtnamen & "").Formula = "='" & y & "'!D17"
    Range("E" & gesamtnamen & "").Formula = "=($D$" & gesamtnamen & "*100)/D3"
    Range("F" & gesamtnamen & "").Formula = "='" & y & "'!D125"
    Range("G" & gesamtnamen & "").Formula = "='" & y & "'!D136"
    Range("H" & gesamtnamen & "").Formula = "='" & y & "'!D18"
    Range("I" & gesamtnamen & "").Formula = "=($H$" & gesamtnamen & "*100)/H3"
    Range("J" & gesamtnamen & "").Formula = "='" & y & "'!D19"
    Range("K" & gesamtnamen & "").Formula = "=($J$" & gesamtnamen & "*100)/J3"
    Range("L" & gesamtnamen & "").Formula = "='" & y & "'!D20"
    Range("N" & gesamtnamen & "").Formula = "=($E$" & gesamtnamen & "+$I$" & gesamtnamen & "+$K$" & gesamtnamen & "+$L$" & gesamtnamen & ")/4"


        
        If gesamtnamen Mod 2 = 0 Then
        Range("A" & gesamtnamen & ":N" & gesamtnamen & "").Interior.ColorIndex = 2
        Else
        Range("A" & gesamtnamen & ":N" & gesamtnamen & "").Interior.Color = "123123140"
        End If
    
    Sheets("psycho").Activate
    
    Range("A" & psychonamen & "").Value = y
    
    Sheets("Gesamtauswertung").Activate
    
    Range("A" & gesamtnamen & "").Value = y
    
    Sheets(y).Activate
         
   End If
   If rs.Fields("Session_Name") = "Arg" Then
     Range("E87").Value = rs.Fields("Max_Score")
     Range("D87").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Beg" Then
     Range("E57").Value = rs.Fields("Max_Score")
     Range("D57").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Beg Aus" Then
     Range("E83").Value = rs.Fields("Max_Score")
     Range("D83").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "EG" Then
     Range("E58").Value = rs.Fields("Max_Score")
     Range("D58").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Eins" Then
     Range("E154").Value = rs.Fields("Max_Score")
     Range("D154").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Eng" Then
     Range("E19").Value = rs.Fields("Max_Score")
     Range("D19").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Kauf" Then
     Range("E125").Value = rs.Fields("Max_Score")
     Range("D125").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Log" Then
     Range("E60").Value = rs.Fields("Max_Score")
     Range("D60").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Mark" Then
     Range("E132").Value = rs.Fields("Max_Score")
     Range("D132").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Mathe" Then
     Range("E59").Value = rs.Fields("Max_Score")
     Range("D59").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Netzwerk" Then
     Range("E84").Value = rs.Fields("Max_Score")
     Range("D84").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Präsent" Then
     Range("E133").Value = rs.Fields("Max_Score")
     Range("D133").Value = rs.Fields("Max von Total_Score")
   End If
   If rs.Fields("Session_Name") = "Rhet" Then
     Range("E134").Value = rs.Fields("Max_Score")
     Range("D134").Value = rs.Fields("Max von Total_Score")
   End If
 

x = y                       'Variable wird gemerkt für den Vergleich am Schleifenanfang

rs.MoveNext                 'in den nächsten RecordSet wechseln
    
Loop                        'Schleifenende

x = ""                                      'x wird für den Vergleich auf Null gesetzt

Application.DisplayAlerts = False

    Sheets("Tabelle1").Select
    ActiveWindow.SelectedSheets.Delete
    
Application.DisplayAlerts = True

MsgBox "Auslesen erfolgreich ! " & Chr(13) & "Es wurden " & i & " Datensätze ausgelesen.", vbInformation, "Meldung"     'Mitteilung an den Benutzer
                                                                                                                        'das das Programm beendet wurde
    rs.Close                'RecordSet schließen
    db.Close                'Datenbank schließen

Set rs = Nothing            'Variablen auf Null setzen
Set db = Nothing


filesavename = Application.GetSaveAsFilename(gruppe & ".xls", _
fileFilter:="Excel Datei (*.xls), *.xls")
    If filesavename <> False Then
        MsgBox "Speichere als: " & filesavename
    End If

ThisWorkbook.SaveAs (filesavename)

Workbooks.Open (filesavename)

'Application.ScreenUpdating = False

End Sub

wird wohl ein Service Pack Problem sein

✔ Speicherüberlauf mit Excel2000

dPo2000

Kosh

Erfahrenes Mitglied

dPo2000

Neue Beiträge