VBA 控制 Excel 例子

Private Sub Workbook_open()''--- Define variables.' Dim xlsbook As Excel.Workbook Dim xlsbookx As Excel.Workbook Dim filen As String Dim strDate, strCust, strDateN, strCustN, strTMP As String Dim iRow, iCount, iSheet As Integer Dim iNewSheet As Boolean''--- Handle C:/TEMP/MIS/Report/TMP0047301.xls' Application.ScreenUpdating = False' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/TMP0047301.xls") xlsbook.Save xlsbook.Close''--- Handle C:/TEMP/MIS/Report/P00473_Form.xls.' Application.ScreenUpdating = False Set xlsbookx = Workbooks.Open(Filename:="C:/TEMP/MIS/Program/P00473A_Form.xls", UpdateLinks:="3")' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/TMP0047301.xls")' iRow = 2 iCount = 0 iSheet = 1 iNewSheet = False strDate = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCust = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) strDateN = "0" strCustN = "0" Do While strCustN <> "" iNewSheet = False If (strDate = strDateN) And (strCust = strCustN) Then If iCount >= 12 Then 'iNewSheet = True 'iSheet = iSheet + 1 xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown End If Else iNewSheet = True iSheet = 1 End If If iNewSheet Then iNewSheet = False iCount = 0 Application.ScreenUpdating = False strDate = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCust = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets("PE(China)").Copy After:=xlsbookx.Sheets(LastSheet) If iSheet = 1 Then strTMP = strCust + "-" + strDate Else strTMP = strCust + "-" + strDate + "-" + Trim(Str(iSheet)) End If LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets(LastSheet).Name = strTMP xlsbookx.Sheets(LastSheet).Select xlsbookx.Sheets(LastSheet).Cells(7, 8).Value = Mid(strDate, 1, 4) + "-" + Mid(strDate, 5, 2) + "-" + Mid(strDate, 7, 2) xlsbookx.Sheets(LastSheet).Cells(10, 8).Value = strCust End If xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 1).Value = xlsbook.Sheets(1).Cells(iRow, 14).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 2).Value = xlsbook.Sheets(1).Cells(iRow, 17).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 4).Value = xlsbook.Sheets(1).Cells(iRow, 4).Value + " " + xlsbook.Sheets(1).Cells(iRow, 5).Value + " " + xlsbook.Sheets(1).Cells(iRow, 6).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 8).Value = xlsbook.Sheets(1).Cells(iRow, 16).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 9).Value = xlsbook.Sheets(1).Cells(iRow, 15).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 10).Value = xlsbook.Sheets(1).Cells(iRow, 18).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3 + 1, 4).Value = "PO#" + xlsbook.Sheets(1).Cells(iRow, 3).Value + " " + xlsbook.Sheets(1).Cells(iRow, 5).Value + " " + xlsbook.Sheets(1).Cells(iRow, 11).Value iRow = iRow + 1 iCount = iCount + 1 strDateN = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCustN = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) Loop''--- Delete The First Sheet.' Application.DisplayAlerts = False xlsbookx.Sheets("PE(China)").Delete Application.DisplayAlerts = True''--- Save C:/TEMP/MIS/Report/P00473.xls.' filen = "C:/TEMP/MIS/Report/P00473_" + Format(Date, "yyyymmdd") + Format(Time, "hhmmss") + ".xls" xlsbookx.SaveAs (filen) xlsbookx.Close Set xlsbookx = Nothing xlsbook.Close Set xlsbook = Nothing''--- Inform user.''MsgBox ("请核对 " + filen)'''--- Quit Application.QuitEnd Sub

 

源数据 TMP0047301

 

新文件 P00473