Excel VBA hors memory

Je reçois une erreur Excel VBA hors memory 007. J'utilise des gains d'efficacité pour effacer le presse-papier, la memory, les ressortingctions d'utilisation de la memory et je l'ai encore dans ma fonction GetData (entier) la deuxième fois qu'elle s'appelle. Des idées? Je suis forcé d'exécuter 32 bits sur mon ordinateur govt.

Sub RunStatusOfFunds() 'Declare worksheet variables Dim HOME As Worksheet Dim CRIS_CRITERIA_DATASHEET As Worksheet Dim DEAMS_CRITERIA_DATASHEET As Worksheet Dim CRITERIA_INSTRUCTIONS As Worksheet Dim DEAMS_DATASHEET As Worksheet Dim CRIS_DATASHEET As Worksheet Dim VSF_DATASHEET As Worksheet Dim CALCULATIONS As Worksheet Dim STATUS As Chart Dim VSF_DEAMS As Worksheet Dim VSF_CRIS As Worksheet 'Set variables to actual worksheets Set HOME = Sheets("Home") Set CRIS_CRITERIA_DATASHEET = Sheets("CRIS_CRITERIA_DATASHEET") Set DEAMS_CRITERIA_DATASHEET = Sheets("DEAMS_CRITERIA_DATASHEET") Set CRITERIA_INSTRUCTIONS = Sheets("CRITERIA_INSTRUCTIONS") Set DEAMS_DATASHEET = Sheets("DEAMS_DATASHEET") Set CRIS_DATASHEET = Sheets("CRIS_DATASHEET") Set VSF_DATASHEET = Sheets("VSF_DATASHEET") Set CALCULATIONS = Sheets("CALCULATIONS") Set STATUS = Charts("STATUS") Set VSF_DEAMS = Sheets("VSF_DEAMS") Set VSF_CRIS = Sheets("VSF_CRIS") 'Declare working variables such as counters, etc. Dim z, n As Integer 'Declare arrays to hold data from tables Dim DEAMS_data_array(0 To 67) As Variant Dim DCriteria_data_array(0 To 9) As Variant Dim CRIS_data_array(0 To 67) As Variant Dim CCriteria_data_array() As Variant 'Declare location variables Dim ppLocation As Ssortingng Dim ptLocation As Ssortingng Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.EnableEvents = False UnlockSheets 'Use password to unlock all sheets 'Request file locations ppLocation = HOME.Cells(19, 11) ptLocation = HOME.Cells(21, 11) VSF_DEAMS.Range("A:Z").Clear VSF_CRIS.Range("A:Z").Clear DEAMS_DATASHEET.Range("A:Z").Clear CRIS_DATASHEET.Range("A:Z").Clear 'Get DEAMS data z = 0 z = GetData(0) If z = 1 Then CancelUpdate 'If no data given exit LockSheets 'Lock sheets HOME.Select 'Change user visual focus to Home Exit Sub End If VSF_CRIS.Cells.Clear 'Get CRIS data z = 0 z = GetData(1) If z = 1 Then CancelUpdate 'If no data given exit LockSheets 'Lock sheets HOME.Select 'Change user visual focus to Home End If 'Copy DEAMS data 'Collect DEAMS headers n = 1 For i = 0 To 67 DEAMS_data_array(i) = DEAMS_DATASHEET.Cells(1, n) n = n + 1 Next i n = 1 For i = 0 To 67 CRIS_data_array(i) = CRIS_DATASHEET.Cells(1, n) n = n + 1 Next i 'Write DEAMS headers, add Description 'VSF_DEAMS.Activate 'VSF_DEAMS.Cells.Clear 'VSF_DEAMS.Cells(1, 1).Activate VSF_DEAMS.Cells(1, 1).Value = "DESCRIPTION" VSF_CRIS.Cells(1, 1).Value = "DESCRIPTION" n = 2 For i = 0 To 67 VSF_DEAMS.Cells(1, n).Value = DEAMS_data_array(i) n = n + 1 Next i n = 2 For i = 0 To 67 VSF_CRIS.Cells(1, n) = CRIS_data_array(i) n = n + 1 Next i Call findDesc(DEAMS_DATASHEET, DEAMS_CRITERIA_DATASHEET, VSF_DEAMS) Call findDesc(CRIS_DATASHEET, CRIS_CRITERIA_DATASHEET, VSF_CRIS) Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub Sub UnlockSheets() If Sheets("HOME").Cells(26, 6).Value = "Sheet is Unlocked" Then Exit Sub Set CrisData = Sheets("CRIS_DATASHEET") Set DEAMSData = Sheets("DEAMS_DATASHEET") Set VSFData = Sheets("VSF_DATASHEET") With CrisData 'Unlock spreadsheets .Unprotect Password:="pass" .Cells.Locked = False End With With DEAMSData .Unprotect Password:="pass" .Cells.Locked = False End With With VSFData .Unprotect Password:="pass" .Cells.Locked = False End With With Sheets("HOME") .Unprotect Password:="pass" .Cells.Locked = False End With Sheets("HOME").Select Sheets("HOME").Cells(26, 6).Value = "Sheet is Unlocked" End Sub Public Function GetData(loc As Integer) As Integer Application.Calculation = xlCalculationManual Dim raw As Workbook, ThisBook As Workbook Dim fileName 'Opens the data sheet from which to work from Set ThisBook = ThisWorkbook If loc = 0 Then MsgBox ("Please select DEAM's Discoverer Viewer export") 'Get the DEAMS File fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _ , "Please select DEAM's Discoverer Viewer STATUS_OF_FUNDS Excel Output") If fileName = False Then GetData = 1 Exit Function End If Set raw = Workbooks.Open(fileName) raw.Sheets(1).Cells(1, 1).EntireRow.Delete raw.Sheets(1).Cells(1, 1).EntireRow.Delete Else MsgBox ("Please select CRIS export") 'Get the CRIS File fileName = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _ , "Please select CRIS export") If fileName = False Then GetData = 1 Exit Function End If Set raw = Workbooks.Open(fileName) End If If loc = 0 Then ThisBook.Sheets("DEAMS_DATASHEET").Range("A:V").Value = raw.Sheets(1).Range("A:V").Value Else Application.CutCopyMode = False raw.Sheets(1).ListObjects("Table1").Unlist raw.Sheets(1).Range("A:Z").ClearFormats ThisBook.Sheets("CRIS_DATASHEET").Range("A:X").Value = raw.Sheets(1).Range("A:X").Value End If raw.Close SaveChanges:=False Application.CutCopyMode = False Set ThisBook = Nothing Set raw = Nothing GetDeamsData = 0 End Function 

• Utilisez Visual Basic pour que les applications puissent lire des données à partir d'une database Excel Spreadsheet
• NE MarcoA Marco à Marco illustrelle
• Est-ce que "Créer la feuille de travail de table2 comme (Sélectionnez * à partir de la feuille de calcul1)" tapez les requêtes SQL sockets en charge à partir de l'environnement Excel en utilisant uniquement le pilote Excel ODBC / ADO?
• Copier la ligne entière de 1 file vers un autre Visual Basic Excel
• Valeur propre d'incrément d'Excel (reference circulaire)