Bonjour tout le monde,
On me demande a mon boulot de faire en sorte qu'une macro (que je n'ai pas cree) qui fonctionne sur excel 2003 fonctionne sur excel 2007.
J'ai changer les terminaisons .xls par .xlsx
Je me suis assure que le fichier excel 2003 soit compatible avec excel 2007
(
http://office.microsoft.com/en-us/excel-help/use-office-excel-2007-with-earlier-versions-of-excel-HA010077561.aspx)
Neanmoins lorsque je lance la macro, le message suivant apparait : 'Run time error '9' subscript out of range'. J'ai lu de nombreux posts a ce sujet, mais aucun ne me permet de resoudre ce probleme.
Voici la macro...En gras ce que me souligne le debuggeur.
Sub MacroNew()
Application.ScreenUpdating = False
Dim location As String
location = Range("f4")
Dim month As String
month = Range("F12")
Dim monthB As String
monthB = Range("F14")
Dim code As String
code = Range("F9")
MsgBox "Make sure the file " & code & ".txt exist in the file " & location & "\Data from Grand Back\, then click on", vbInformation, "Hotel chosen"
'open hxxxx.txt file
Workbooks.OpenText Filename:= _
location & "\Data from Grand Back" & code & ".txt", Origin:=xlWindows, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(6, 1), Array(12, 1), Array(40, 1), Array(45, 1), Array(90, 1), Array(102, 1), _
Array(120, 1), Array(138, 1), Array(157, 1), Array(176, 1))
'format Trial Balance
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Range("A48").Select
ActiveCell.FormulaR1C1 = "=IF(MID(RC[4],22,5)=""ENTRY"",RC[5],R[-1]C)"
Range("B48").Select
ActiveCell.FormulaR1C1 = "=IF(MID(RC[3],16,6)=""CENTER"",RC[4],R[-1]C)"
Range("A48:B48").Select
Selection.AutoFill Destination:=Range("A48:B51"), Type:=xlFillDefault
Range("A48:B51").Select
Selection.AutoFill Destination:=Range("A48:B3192"), Type:=xlFillDefault
Range("A48:B3192").Select
Columns("A:C").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=">600000", Operator:=xlAnd, _
Criteria2:="<800000"
Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Columns("D:D").Select
Selection.ClearContents
Range("D2").Select
ActiveCell.FormulaR1C1 = "=+RC[1]&RC[2]&RC[3]"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1527")
Range("D2:D1527").Select
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Cells.EntireColumn.AutoFit
Rows("1:1").Select
Selection.ClearContents
Range("E1").Select
ActiveCell.FormulaR1C1 = "Op balance"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Debit"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Credit"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Closing balance Debit"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Closing balance Credit"
Range("A1").Select
Workbooks.Open Filename:= _
location & "\referential.xlsx"
Sheets("referential").Select
Sheets("referential").Copy After:=Workbooks(code & ".txt").Sheets(2)
Sheets("Sheet1").Select
Windows("referential.xlsx").Activate
ActiveWindow.Close
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("G:H").Select
Selection.Delete Shift:=xlToLeft
Columns("A:B").Select
Selection.Insert Shift:=xlToRight
Range("I2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],referential!C[-8]:C[-5],4,0)"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Analytical Acc"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I1527")
Range("I2:I527").Select
Range("J1").Select
ActiveCell.FormulaR1C1 = "Amount"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=+RC[-2]-RC[-3]"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J1527")
Range("J2:J527").Select
Columns("I:J").Select
Selection.Font.ColorIndex = 5
Range("B2").Select
ActiveCell.FormulaR1C1 = "=RC[2]&RC[7]"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B1527")
Range("B2:B527").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[3],1)&RC[8]"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1527")
Range("A2:A527").Select
Columns("A:B").Select
Selection.Font.ColorIndex = 5
Rows("1:1").Select
Selection.Font.ColorIndex = 5
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("B1").Select
ActiveCell.FormulaR1C1 = "2"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3"
Range("D1").Select
ActiveCell.FormulaR1C1 = "4"
Range("E1").Select
ActiveCell.FormulaR1C1 = "5"
ActiveWorkbook.SaveAs Filename:= _
location & "" & code & ".xlsx" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Data"
Range("A1").Select
Sheets("Data").Select
Sheets.Add
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "N N-1"
Range("A1").Select
Sheets.Add
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "N Bud"
Range("A1").Select
'Extract of the "N N-1" frame
Workbooks.Open Filename:= _
location & "\referential.xlsx"
Sheets("N N-1").Select
Cells.Select
Range("F9").Activate
Selection.Copy
Windows(code & ".xlsx").Activate
Sheets("N N-1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
'Extract of the "N Bud" frame
Workbooks.Open Filename:= _
location & "\referential.xlsx"
Sheets("N Bud").Select
Cells.Select
Range("F9").Activate
Selection.Copy
Windows(code & ".xlsx").Activate
Sheets("N Bud").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
'copy of the 2008 data
Windows("referential.xlsx").Activate
Sheets(month).Select
Cells.Find(what:=code, After:=ActiveCell, LookIn:=xlFormulas, lookat _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.EntireColumn.Select
Selection.Copy
Sheets("2008").Select
Columns("E:E").Select
ActiveSheet.Paste
Calculate
'copy of the 2009B data
Windows("referential.xlsx").Activate
Sheets(monthB).Select
Cells.Find(what:=code, After:=ActiveCell, LookIn:=xlFormulas, lookat _
:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.EntireColumn.Select
Selection.Copy
Sheets("2009B").Select
Columns("E:E").Select
ActiveSheet.Paste
Calculate
'trsf of the 2008 data to the current spreadsheet
Windows("referential.xlsx").Activate
Sheets("2008").Select
Sheets("2008").Copy After:=Workbooks(code & ".xlsx").Sheets(4)
Sheets("2008").Select
Windows(code & ".xlsx").Activate
Sheets("N N-1").Select
Range("F1").Activate
Range("F1:F380").Select
Cells.Replace what:="'[referential.xlsx]2008'", Replacement:="'2008'", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("G1:G380").Select
Cells.Replace what:="[referential.xlsx]Data!", Replacement:="Data!", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("F311").Select
Cells.Replace what:="[referential.xlsx]Data!", Replacement:="Data!", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("C2") = code
Range("E2") = month
'trsf of the 2009 Budget data to the current spreadsheet
Windows("referential.xlsx").Activate
Sheets("2009B").Select
Sheets("2009B").Copy After:=Workbooks(code & ".xlsx").Sheets(4)
Sheets("2009B").Select
Windows(code & ".xlsx").Activate
Sheets("N Bud").Select
Range("F1").Activate
Range("F1:F380").Select
Cells.Replace what:="'[referential.xlsx]2009B'", Replacement:="'2009B'", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("G1:G380").Select
Cells.Replace what:="[referential.xlsx]Data!", Replacement:="Data!", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("F311").Select
Cells.Replace what:="[referential.xlsx]Data!", Replacement:="Data!", lookat:=xlPart, _
searchorder:=xlByRows, MatchCase:=False
Range("C2") = code
Range("E2") = month
'THE NEXT LINE WILL CLOSE THE REFERENTIAL
Windows("referential.xlsx").Activate
ActiveWindow.Close savechanges = False
'AND WE REACTIVATE THE HCODE FILE
Windows(code & ".xlsx").Activate
MsgBox "Choose the level above which variances are shown", vbInformation, "Variance Minimum Level"
Range("H3").Select
'THE FOLLOWINGS LINES ARE SET TO OGANISE AND FIX THE PRINT OUT LAYOUT OF THE SPREADSHEET
Windows(code & ".xlsx").Activate
Sheets("N Bud").Select
ActiveSheet.PageSetup.PrintArea = _
"$C$1:$H$62,$C$64:$H$120,$C$122:$H$189,$C$191:$H$224,$C$227:$H$292,$C$295:$H$363,$C$365:$H$430"
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("H3").Select
'THE FOLLOWINGS LINES ARE SET TO OGANISE AND FIX THE PRINT OUT LAYOUT OF THE SPREADSHEET
Windows(code & ".xlsx").Activate
Sheets("N N-1").Select
ActiveSheet.PageSetup.PrintArea = _
"$C$1:$H$61,$C$63:$H$118,$C$120:$H$184,$C$186:$H$221,$C$224:$H$288,$C$291:$H$358,$C$360:$H$425"
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Sheets("N N-1").Select
ActiveWindow.DisplayGridlines = False
Sheets("N Bud").Select
ActiveWindow.DisplayGridlines = False
Range("H3").Select
'THIS IS TO HIDE THE VARIOUS DATA SPREADSHEET
Sheets(Array("Data", code, "referential", "2008", "2009B")).Select
Sheets("2008").Activate
ActiveWindow.SelectedSheets.Visible = False
Range("J39").Select
ActiveWindow.SmallScroll Down:=-15
Range("H3").Select
End Sub
Si vous pouviez me dire, s'il vous plait, pourquoi elle bug ou comment la rendre compatible avec excel 2007 ca serait genial.
Cette macro a pour but d'extraire des donnees de plusieurs feuilles pour ensuite les faire apparaitre sous forme de tableaux (plus exactement un compte de resultat)
En vous remerciant,
Bonne journee.
Debutant
RAPHAEL
Afficher la suite