2014-02-19 2 views
0

배경 : 64 비트 시스템에서 실행되는 6 개월 동안 VBA 사용. Excel 2010 버전한 사용자에 대해서만 스크립트가 범위를 벗어 났습니까?

두 가지. 하나, 그리고 이것은 문제이며, 한 줄의 코드에 대해 '범위를 벗어난 스크립트 오류'를받는 사용자 한 명과 관련이 있습니다. 이것은 동일한 하드웨어 및 OS 사양을 가진 다른 사용자에게 잘 돌아갔다. 둘째, 코드 최적화에 대한 조언이 잘 전달됩니다.

오류가 발생 코드의

라인 :

 Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") 

매크로

Option Explicit 
    Sub getEst() 

    'Used for inserting values from quarterly estimates paid to shareholders 

    Dim xCell As Range, findCell As Range, carryFWDrng1 As Range, carryFWDrng2 As Range 
    Dim Q1_est_paid As Range, Q2_est_paid As Range, Q3_est_paid As Range, Q4_est_paid As Range 
    Dim tempST$, tempState$, qtr$, year$, pYear$, STest$ 
    Dim apportion As Workbook, STabbr As Workbook, carryFWD As Workbook 
    Dim qrtEst1 As Workbook, qrtEst2 As Workbook, qrtEst3 As Workbook, qrtEst4 As Workbook 
    Dim q1Federal&, q2Federal&, q3Federal&, q4Federal& 
    Dim t As Date 
    Dim STabbrPath$, STabbrFname$, carryFWDpath$, carryFWDfName$ 
    Dim qrtEst1Path$, qrtEst1Fname$, qrtEst2Path$, qrtEst2Fname$, qrtEst3Path$, qrtEst3Fname$, qrtEst4Path$, qrtEst4Fname$ 


    'input box to get year for future use 
    year = InputBox("Please type in the tax return year", "Tax Return Year", Format(Date - 365, "YYYY")) 

    pYear = year - 1 

' t = Now() 'timer to measure sub length 

    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
    Application.AskToUpdateLinks = False 

    'list file pathways and file names 
    STabbrPath = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" 
    STabbrFname = "States w Abbr.xlsx" 
    qrtEst1Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q1 " & year & "\Blocker & LP Check Requests\" 
    qrtEst1Fname = "GBO Q1 " & year & " Estimates Funds Request.xlsx" 
    qrtEst2Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q2 " & year & "\Blocker & LP Check Requests\" 
    qrtEst2Fname = "GBO Q2 " & year & " Estimates Funds Request.xlsx" 
    qrtEst3Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q3 " & year & "\Blocker & LP Check Requests\" 
    qrtEst3Fname = "GBO Q3 " & year & " Estimates Funds Request.xlsx" 
    qrtEst4Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q4 " & year & "\Blocker & LP Check Requests\" 
    qrtEst4Fname = "GBO Q4 " & year & " Estimates Funds Request.xlsx" 
    carryFWDpath = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\Blocker Returns\" & pYear & "\Granite Block Offshore\" 
    carryFWDfName = "Granite Block Offshore income tax recap " & pYear & ".xlsx" 

    'open files 
    Application.Workbooks.Open Filename:=STabbrPath & STabbrFname 
    Application.Workbooks.Open Filename:=qrtEst1Path & qrtEst1Fname 
    Application.Workbooks.Open Filename:=qrtEst2Path & qrtEst2Fname 
    Application.Workbooks.Open Filename:=qrtEst3Path & qrtEst3Fname 
    Application.Workbooks.Open Filename:=qrtEst4Path & qrtEst4Fname 
    Application.Workbooks.Open Filename:=carryFWDpath & carryFWDfName 


    Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") 
    Set STabbr = Application.Workbooks("States w Abbr") 
    Set carryFWD = Application.Workbooks("Granite Block Offshore income tax recap " & pYear) 
    Set qrtEst1 = Application.Workbooks("GBO Q1 " & year & " Estimates Funds Request") 
    Set qrtEst2 = Application.Workbooks("GBO Q2 " & year & " Estimates Funds Request") 
    Set qrtEst3 = Application.Workbooks("GBO Q3 " & year & " Estimates Funds Request") 
    Set qrtEst4 = Application.Workbooks("GBO Q4 " & year & " Estimates Funds Request") 


    Set Q1_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _ 
    .Worksheets("Granite Block Offshore").Range("F58:DB58") 
    Set Q2_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _ 
    .Worksheets("Granite Block Offshore").Range("F60:DB60") 
    Set Q3_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _ 
    .Worksheets("Granite Block Offshore").Range("F62:DB62") 
    Set Q4_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _ 
    .Worksheets("Granite Block Offshore").Range("F64:DB64") 
    Set carryFWDrng1 = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _ 
    .Worksheets("Granite Block Offshore").Range("F57:DB57") 
    Set carryFWDrng2 = Application.Workbooks("Granite Block Offshore income tax recap " & pYear) _ 
    .Worksheets("Granite Block Offshore").Range("K9:K59") 

    apportion.Activate 

'For loop to move through each cell in carryFWD range 
    For Each xCell In carryFWDrng1 
     If xCell.Offset(-56, 0).Value = "" Then 
      'do nothing 
     Else: tempST = xCell.Offset(-56, 0).Value 
       STabbr.Activate 'activate States w Abbr file to find full state name 
       Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var 
        If findCell Is Nothing Then 
        'do nothing 
        Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
        carryFWD.Activate 'activate GBO tax recap file 
       Set findCell = Range("A9:A59").Find(what:=tempState, lookat:=xlWhole, After:=Range("A9")) 'search State range and find tempState var 
        If findCell Is Nothing Then 
        STest = "0" 
        Else: STest = findCell.Offset(0, 10).Value 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
       apportion.Activate 'activate apportion file 
        xCell.Value = STest 
     End If 
    Next xCell 

    apportion.Activate 

'For loop to move through each cell in Q1 range 
    For Each xCell In Q1_est_paid 
     If xCell.Offset(-57, 0).Value = "" Then 
      'do nothing 
     Else: tempST = xCell.Offset(-57, 0).Value 
       STabbr.Activate 'activate States w Abbr file to find full state name 
       Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var 
        If findCell Is Nothing Then 
        'do nothing 
        Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
        qrtEst1.Activate 'activate Q1 payment file 
       Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var 
        If findCell Is Nothing Then 
        STest = "0" 
        Else: STest = findCell.Offset(0, 1).Value 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
       apportion.Activate 'activate apportion file 
        xCell.Value = STest 
     End If 
    Next xCell 

    qrtEst1.Activate 'get Federal est in Q1 
    q1Federal = qrtEst1.Worksheets("GBO").Range("B5") 
    apportion.Activate 
    apportion.Worksheets("Granite Block Offshore").Range("D58").Value = q1Federal 

'For loop to move through each cell in Q2 range 
    For Each xCell In Q2_est_paid 
     If xCell.Offset(-59, 0).Value = "" Then 
      'do nothing 
     Else: tempST = xCell.Offset(-59, 0).Value 
       STabbr.Activate 'activate States w Abbr file to find full state name 
       Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var 
        If findCell Is Nothing Then 
        'do nothing 
        Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
        qrtEst2.Activate 'activate Q2 payment file 
       Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var 
        If findCell Is Nothing Then 
        STest = "0" 
        Else: STest = findCell.Offset(0, 1).Value 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
       apportion.Activate 'active apportion file 
        xCell.Value = STest 
     End If 
    Next xCell 

    qrtEst2.Activate 'get Federal est in Q2 
    q2Federal = qrtEst2.Worksheets("GBO").Range("B5") 
    apportion.Activate 
    apportion.Worksheets("Granite Block Offshore").Range("D60").Value = q2Federal 

'For loop to move through each cell in Q3 range 
    For Each xCell In Q3_est_paid 
     If xCell.Offset(-61, 0).Value = "" Then 
      'do nothing 
     Else: tempST = xCell.Offset(-61, 0).Value 
       STabbr.Activate 'activate States w Abbr file to find full state name 
       Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var 
        If findCell Is Nothing Then 
        'do nothing 
        Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
        qrtEst3.Activate 'activate Q3 payment file 
       Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var 
        If findCell Is Nothing Then 
        STest = "0" 
        Else: STest = findCell.Offset(0, 1).Value 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
       apportion.Activate 'active apportion file 
        xCell.Value = STest 
     End If 
    Next xCell 

    qrtEst3.Activate 'get Federal est in Q3 
    q3Federal = qrtEst3.Worksheets("GBO").Range("B5") 
    apportion.Activate 
    apportion.Worksheets("Granite Block Offshore").Range("D62").Value = q3Federal 

'For loop to move through each cell in Q4 range 
    For Each xCell In Q4_est_paid 
     If xCell.Offset(-63, 0).Value = "" Then 
      'do nothing 
     Else: tempST = xCell.Offset(-63, 0).Value 
       STabbr.Activate 'activate States w Abbr file to find full state name 
       Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var 
        If findCell Is Nothing Then 
        'do nothing 
        Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
        qrtEst4.Activate 'activate Q3 payment file 
       Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var 
        If findCell Is Nothing Then 
        STest = "0" 
        Else: STest = findCell.Offset(0, 1).Value 
        End If 
       Set findCell = Nothing 'clear findcell in memory 
       apportion.Activate 'active apportion file 
        xCell.Value = STest 
     End If 
    Next xCell 

    qrtEst4.Activate 'get Federal est in Q4 
    q4Federal = qrtEst4.Worksheets("GBO").Range("B5") 

    apportion.Activate 
    apportion.Worksheets("Granite Block Offshore").Range("D64").Value = q4Federal 

    Range("DK57").Value = "Carry FWD source file pathway" 
    Range("DK58").Value = "Q1 source file pathway" 
    Range("DK60").Value = "Q2 source file pathway" 
    Range("DK62").Value = "Q3 source file pathway" 
    Range("DK64").Value = "Q4 source file pathway" 
    Range("DL57").Value = carryFWDpath & carryFWDfName 
    Range("DL58").Value = qrtEst1Path & qrtEst1Fname 
    Range("DL60").Value = qrtEst2Path & qrtEst2Fname 
    Range("DL62").Value = qrtEst3Path & qrtEst3Fname 
    Range("DL64").Value = qrtEst4Path & qrtEst4Fname 

    STabbr.Close savechanges:=False 
    carryFWD.Close savechanges:=False 
    qrtEst1.Close savechanges:=False 
    qrtEst2.Close savechanges:=False 
    qrtEst3.Close savechanges:=False 
    qrtEst4.Close savechanges:=False 

    Set Q1_est_paid = Nothing 
    Set Q2_est_paid = Nothing 
    Set Q3_est_paid = Nothing 
    Set Q4_est_paid = Nothing 
    Set qrtEst1 = Nothing 
    Set qrtEst2 = Nothing 
    Set qrtEst3 = Nothing 
    Set qrtEst4 = Nothing 
    Set STabbr = Nothing 
    Set apportion = Nothing 
    Set carryFWD = Nothing 

    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.EnableEvents = True 
    Application.AskToUpdateLinks = True 

'MsgBox ("Macro duration : " & Format(Now() - t, "hh:mm:ss")) 'timer results 

End Sub 
를 실행할 때 모듈이 위치하며, 오픈을 말할 때문에 불필요한 버튼과 activeworkbook에 할당되는 경우 위의 통합 문서입니다

Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions.xls") 

또는 .xlsm macr 경우 :

답변

0

보십시오 확장자를 추가 됐어. 사용자가 파일 확장자를 숨길 수 있습니다.

또한 실제 경로를 표시하는 대신 게시하는 대신 \ mypath \를 사용하여

관련 문제