2017-09-13 5 views
0

入力を受け取り、Excelレポートを生成してコピーするこのマクロを持っています。私は入力ファイルの相対パスを渡そうとしたとき、私は "ランタイムエラー9" - 範囲外のサブスクリプトを取得しています。デバッガがエラーコンテキストとして各shを指している間。入力ファイルの相対パススクリプトに含まれていますエラー報告-VBA

これを修正するにはどうすればよいですか?

Sub buildSCTR() 
    ' 
    ' Merge CSV and built pivot for SCTR 
    ' Ver 0.1 
    ' 5-July-2017 P. Coffey 
    ' 

Const FILELIMIT = 0 'used to hardcode number of files will work with. better ways exist but this will do for now 

Dim firstFilename As String 
Dim secondFilename As String 
Dim outputFilename As String 
Dim element As Variant 
Dim dirLocation As String 
Dim macroWb As Object 
Dim lastrow As Integer 
Dim samName As String 
Dim RootFolder As String 

'code allows for multiple import, but using it for one one import here 
Dim filenameArr(0 To FILELIMIT) As Variant 'so can push cells into it later 
Dim inputSelected As Variant 'has to variant to iterate over via for each even though its a string 

Set macroWb = ThisWorkbook 

RootFolder = ActiveWorkbook.Path 

'get new csv to load 
    'Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    ' With fd 
     ' .AllowMultiSelect = True 
     ' .Title = "Pick SC file to load" 
     '.Filters.Clear 
     '.Filters.Add "csv", "*.csv*" 

     'If .Show = True Then 

     ' i = 0 
      ' For Each inputSelected In .SelectedItems 
      '  filenameArr(i) = Dir(inputSelected)  'kludgy.... 
      ' dirLocation = Split(inputSelected, filenameArr(i))(0) 
      ' i = i + 1 
      'Next inputSelected 

     ' Else 
     ' MsgBox ("Nothing selected") 
     ' Exit Sub 
     ' End If 
     'End With 

    Application.StatusBar = "Starting to update" 

    element = RootFolder + "/Output/_SCT_Details_With_Comments.csv" 


    ' For Each element In filenameArr() 
     If Not IsEmpty(element) Then 'as hardcoded length of array have to do this 
      Workbooks.Open (element) 
      Call CopyWorkbook(CStr(element), macroWb.Name) 
      'close csv as done with it 
      Workbooks(element).Close SaveChanges:=False 
     End If 
    'Next element 

'convert to table 
    samName = ActiveSheet.Range("A2").Value 
    ActiveSheet.Name = samName & "_SCT_Data" 

    'assumes col A is contiguous 
    lastrow = ActiveSheet.Range("A1").End(xlDown).Row 

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A1:$U" & lastrow), , xlYes).Name = "SCT" 

'build pivot 
    Dim objWs As Worksheet 
    Dim objPT As PivotTable 
    Dim objPC As PivotCache 

    Sheets.Add.Name = "Summary" 
    Set objWs = ActiveSheet 

    Set objPC = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SCT") 
    Set objPT = objPC.CreatePivotTable(objWs.Range("A3"), TableName:="SCTR") 

    With ActiveSheet.PivotTables("SCTR").PivotFields("Target_SC") 
     .Orientation = xlColumnField 
     .Position = 1 
    End With 
    With ActiveSheet.PivotTables("SCTR").PivotFields("Action") 
     .Orientation = xlRowField 
    End With 
    ActiveSheet.PivotTables("SCTR").AddDataField ActiveSheet.PivotTables(_ 
     "SCTR").PivotFields("PNI_SC"), "Count of PNI_SC", xlCount 

'have to do it in this order else vba was removing pni_sc from row field...who knows why 
    With ActiveSheet.PivotTables("SCTR").PivotFields("PNI_SC") 
     .Orientation = xlRowField 
     .Position = 1 
    End With 

'--update sheet with last sync info 
    macroWb.Sheets("Summary").Range("A1").Value = samName 
    macroWb.Sheets("Summary").Range("A3").NumberFormat = "h:mm dd/mm" 


'save as new file 
    Dim timestamp As String 
    timestamp = Format(Now(), "mmddhh") 

    ActiveWorkbook.SaveAs Filename:= _ 
     dirLocation & samName & "_SCTR_" & timestamp & ".xlsm" _ 
     , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 

'exit msg 
    Application.StatusBar = False 
    Application.ScreenUpdating = True 
    MsgBox ("Completed - saved file as " & dirLocation & samName & "_SCTR_" & timestamp & ".xlsm") 


End Sub 

Sub CopyWorkbook(source As String, target As String) 


'copy all sheets from one workbook to another 

Dim sh As Worksheet, wb As Workbook 

    Set wb = Workbooks(target) 
    For Each sh In Workbooks(source).Worksheets 
     sh.Copy After:=wb.Sheets(wb.Sheets.Count) 
    Next sh 

End Sub 
+0

ワークブック "source"と "target"を開いて、シートをコピーする必要があります。 – h2so4

+0

返信いただきありがとうございます。コピーを開始する前に、スクリプトを提案するか、ソースとターゲットを開くようにコードを修正してください。 – Sam

+0

@ sam、あなたのコードをもっと詳しく読んだら、両方のブックが開いているように見えます。 – h2so4

答えて

1

問題はソースがワークブックのフルネームが含まれているという事実によるものである(パスを含む)およびExcelは(パスなし)ワークブックの短縮名のみを想定してい

ので、呼び出し命令を適応させますこのように

Call CopyWorkbook(ActiveWorkbook.Name, macroWb.Name) 
+0

すぐに解決していただきありがとうございます.i予想どおりにoutptutを実行して生成することができます – Sam

+0

これがあなたの質問に対する回答であれば、回答を検証できますか?ありがとう – h2so4

+0

はい、提案された変更は、最終的に生成された出力がExcelにsucessfulを実行した。 – Sam

関連する問題