여러 WOrkbos에 대한 머리글 쓰기

Question

항목 수를 기반으로 Excel 통합 문서를 동적으로 만들고 있는데, 실제로 각 통합 문서에 동일한 머리글을 쓰려고합니다. 내 아래 구문은 첫 번째 통합 문서에서 작동하지만 두 번째 새 통합 문서가 만들어지면 오류가 발생합니다.

이것은 내 구문입니다. 헤더 행이 만들어지는 각 통합 문서에 기록되도록하려면 어떻게해야합니까?

Set xlApp = CreateObject("Excel.Application") 
xlApp.Visible = True 
Do While Not rs1.EOF 
    i = 0 
    x = 1 
    name = rs1.Fields(0).Value 
    Set xlWb = xlApp.Workbooks.Add 
    row = 1 
    xyz = 0  
    Set HeaderWrite = xlWb.Worksheets(1)  
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 1" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 2" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 3" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 4" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 5" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 6" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 7" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 8" 
    xyz = xyz + 1 
    HeaderWrite.Cells(row, xyz + 1).Value = "Header 9" 
    xyz = xyz + 1  
    xlWb.Worksheets(1).Range("$A$2") = name 
    Set xlR = xlWb.Worksheets(1).Range("$N$2") 
    Set rs2 = Db.OpenRecordset("SELECT * FROM MasterDB", dbOpenDynaset) 
    With rs2 
    .MoveLast 
    .MoveFirst 
    Do While Not .EOF 
     xlR.Value = .Fields(0).Value 
     xlR.Offset(ColumnOffset:=1).Value = .Fields(2).Value 
     xlR.Offset(ColumnOffset:=2).Value = "Mainstreem" 
     HeaderWrite.Cells(row, xyz + 1).Value = "Dept_" & i 
     xyz = xyz + 1 
     HeaderWrite.Cells(row, xyz + 1).Value = "Item" & i 
     xyz = xyz + 1 
     HeaderWrite.Cells(row, xyz + 1).Value = "CRN" & i 
     xyz = xyz + 1 
     i = i + 1 
     Debug.Print i 
     If i = 50 Then 
      i = 0 
      x = x + 1 
      xlWb.SaveAs FileName:=sPath & sFile, FileFormat:=xlOpenXMLWorkbook 
      xlWb.Close SaveChanges:=True 
      Set xlWb = xlApp.Workbooks.Add 
      sFile = name & "_" & "SalesLog" & x & ".xlsx" 
      xlWb.Worksheets(1).Range("$C$2") = name 
      Set xlR = xlWb.Worksheets(1).Range("$Q$2") 
     Else 
      Set xlR = xlR.Offset(ColumnOffset:=3) 
     End If 
     .MoveNext 
    Loop 
    .Close 
    End With 

Answer 1

이 완전히 테스트되지 않은,하지만 다행스럽게도 필자는 올바른 장소에 물건을 이동 한 :

Set xlApp = CreateObject("Excel.Application") 
xlApp.Visible = True 
Do While Not rs1.EOF 
    i = 0 
    x = 0 ' was 1 ?? 
    name = rs1.Fields(0).Value 
    Set rs2 = Db.OpenRecordset("SELECT * FROM MasterDB", dbOpenDynaset) 
    With rs2 
    .MoveLast 
    .MoveFirst 
    Do While Not .EOF 
     If i = 0 Then 
      Set xlWb = xlApp.Workbooks.Add 
      row = 1 ' This always stays as 1 ?!?! 
      xyz = 0  
      Set HeaderWrite = xlWb.Worksheets(1)  
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 1" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 2" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 3" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 4" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 5" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 6" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 7" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 8" 
      xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Header 9" 
      If x = 0 Then 
       HeaderWrite.Range("$A$2") = name 
       Set xlR = HeaderWrite.Range("$N$2") 
      Else 
       HeaderWrite.Range("$C$2") = name 
       Set xlR = HeaderWrite.Range("$Q$2") 
      End If 
     End If 
     xlR.Value = .Fields(0).Value 
     xlR.Offset(ColumnOffset:=1).Value = .Fields(2).Value 
     xlR.Offset(ColumnOffset:=2).Value = "Mainstreem" 
     xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Dept_" & i 
     xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "Item" & i 
     xyz = xyz + 1 : HeaderWrite.Cells(row, xyz).Value = "CRN" & i 
     Set xlR = xlR.Offset(ColumnOffset:=3) 
     i = i + 1 
     Debug.Print i 
     If i = 50 Then 
      i = 0 
      x = x + 1 
      'I moved this up - otherwise I don't think you have a filename 
      sFile = name & "_" & "SalesLog" & x & ".xlsx" 
      xlWb.SaveAs FileName:=sPath & sFile, FileFormat:=xlOpenXMLWorkbook 
      xlWb.Close SaveChanges:=True 
     End If 
     .MoveNext 
    Loop 
    .Close 
    End With