Private Sub Workbook_open() ' '--- Define variables. ' Dim xlsbook As Excel.Workbook Dim xlsbookx As Excel.Workbook Dim filen As String Dim strSheetName As String Dim strTXU As String Dim strTDS As String Dim strLCC As String Dim strLDS As String Dim strRPT As String Dim strTYP As String Dim strOPT As String Dim strPER As String Dim strVAT As String Dim strCust As String Dim strCustNew As String Dim strCustNameNew As String Dim strParentNew As String Dim strCUR As String Dim strCURNew As String Dim iRow1 As Integer Dim iRow2 As Integer Dim iCount As Integer Dim iSheet As Integer Dim iNewSheet As Boolean ' '--- Handle C:/TEMP/MIS/Report/TMP0052301.xls ' Application.ScreenUpdating = False ' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00523/TMP0052301.xls") xlsbook.Save xlsbook.Close ' '--- Handle C:/TEMP/MIS/Report/TMP0052302.xls ' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00523/TMP0052302.xls") ' '--- Default variable ' strTXU = Trim(xlsbook.Sheets(1).Cells(2, 1).Value) strTDS = Trim(xlsbook.Sheets(1).Cells(2, 2).Value) strLCC = Trim(xlsbook.Sheets(1).Cells(2, 3).Value) strLDS = Trim(xlsbook.Sheets(1).Cells(2, 4).Value) strRPT = Trim(xlsbook.Sheets(1).Cells(2, 5).Value) strTYP = Trim(xlsbook.Sheets(1).Cells(2, 6).Value) strOPT = Trim(xlsbook.Sheets(1).Cells(2, 7).Value) strPER = Trim(xlsbook.Sheets(1).Cells(2, 8).Value) xlsbook.Save xlsbook.Close ' '--- Handle C:/TEMP/MIS/Report/P00523_SUMForm.xls. ' Application.ScreenUpdating = False Set xlsbookx = Workbooks.Open(Filename:="C:/TEMP/MIS/Program/P00523_SUMForm.xls", UpdateLinks:="3") Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00523/TMP0052301.xls") ' '**** 2009.05.13 ' iRow = 2 iCount = 8 iSheet = 1 iNewSheet = False strCust = "Null" strCustNew = Trim(xlsbook.Sheets(1).Cells(iRow, 8).Value) strCustNameNew = Trim(xlsbook.Sheets(1).Cells(iRow, 9).Value) strParentNew = Trim(xlsbook.Sheets(1).Cells(iRow, 10).Value) strCUR = "Null" strCURNew = Trim(xlsbook.Sheets(1).Cells(iRow, 17).Value) strVAT = "N" Do While strCustNew <> "" '---B1 iNewSheet = False ' '--- Same Page(File) ' If (strCust = strCustNew) And (strCUR = strCURNew) Then '---B2 Else '---X2 If (strCust <> "Null") Then '---B3 LastSheet = xlsbookx.Sheets.Count If (LastSheet > 1) And (iCount > 8) Then '---B4 ' '--- Total ' xlsbookx.Sheets(LastSheet).Cells(iCount, 17).Value = "=SUM(Q8:Q" & iCount - 1 & ")" If strVAT = "Y" Then xlsbookx.Sheets(LastSheet).Cells(7, 18).Value = "VAT %" xlsbookx.Sheets(LastSheet).Cells(7, 19).Value = "Rebate Amount With VAT" xlsbookx.Sheets(LastSheet).Cells(iCount, 19).Value = "=SUM(S8:S" & iCount - 1 & ")" End If End If '---E4 ' '--- Delete The First Sheet. ' Application.DisplayAlerts = False xlsbookx.Sheets("P00523SUM").Delete Application.DisplayAlerts = True ' '--- Save C:/TEMP/MIS/Report/P00523/Cust.xls. ' filen = "C:/TEMP/MIS/Report/P00523/" + strCust + "_Rebate_" + Format(Date, "yyyymmdd") + Format(Time, "hhmmss") + ".xls" xlsbookx.SaveAs (filen) xlsbookx.Close SaveChanges:=False ' '--- Handle Excel 2009.05.13 ' UPDExcel filen, strCust, strOPT, strVAT, Str(iCount) ' '--- Handle C:/TEMP/MIS/Report/P00523_SUMForm.xls. '--- New File ' Application.ScreenUpdating = False Set xlsbookx = Workbooks.Open(Filename:="C:/TEMP/MIS/Program/P00523_SUMForm.xls", UpdateLinks:="3") End If '---E3 iNewSheet = True strVAT = "N" If (strCust = strCustNew) Then iSheet = iSheet + 1 Else iSheet = 1 End If End If '---E2 If iNewSheet Then '---B2 iNewSheet = False iCount = 8 Application.ScreenUpdating = False LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets("P00523SUM").Copy After:=xlsbookx.Sheets(LastSheet) If iSheet = 1 Then '---B3 strSheetName = strCustNew Else strSheetName = strCustNew + "-" + Trim(Str(iSheet)) End If '---E3 LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets(LastSheet).Name = strSheetName xlsbookx.Sheets(LastSheet).Select xlsbookx.Sheets(LastSheet).Cells(1, 3).Value = Mid(strPER, 1, 4) + " " + strRPT 'xlsbookx.Sheets(LastSheet).Cells(2, 14).Value = strLDS xlsbookx.Sheets(LastSheet).Cells(3, 3).Value = myMONStr(strPER) xlsbookx.Sheets(LastSheet).Cells(4, 3).Value = strCustNew xlsbookx.Sheets(LastSheet).Cells(5, 3).Value = strCustNameNew xlsbookx.Sheets(LastSheet).Cells(4, 8).Value = strParentNew xlsbookx.Sheets(LastSheet).Cells(5, 8).Value = strCURNew End If '---E2 strCust = Trim(xlsbook.Sheets(1).Cells(iRow, 8).Value) strCUR = Trim(xlsbook.Sheets(1).Cells(iRow, 17).Value) xlsbookx.Sheets(LastSheet).Cells(iCount, 1).Value = xlsbook.Sheets(1).Cells(iRow, 1).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 2).Value = xlsbook.Sheets(1).Cells(iRow, 2).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 3).Value = xlsbook.Sheets(1).Cells(iRow, 3).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 4).Value = xlsbook.Sheets(1).Cells(iRow, 4).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 5).Value = xlsbook.Sheets(1).Cells(iRow, 5).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 6).Value = xlsbook.Sheets(1).Cells(iRow, 6).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 7).Value = xlsbook.Sheets(1).Cells(iRow, 7).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 8).Value = xlsbook.Sheets(1).Cells(iRow, 11).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 9).Value = xlsbook.Sheets(1).Cells(iRow, 12).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 10).Value = xlsbook.Sheets(1).Cells(iRow, 14).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 11).Value = xlsbook.Sheets(1).Cells(iRow, 15).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 12).Value = xlsbook.Sheets(1).Cells(iRow, 16).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 13).Value = xlsbook.Sheets(1).Cells(iRow, 19).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 14).Value = xlsbook.Sheets(1).Cells(iRow, 18).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 15).Value = xlsbook.Sheets(1).Cells(iRow, 20).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 16).Value = xlsbook.Sheets(1).Cells(iRow, 21).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 17).Value = xlsbook.Sheets(1).Cells(iRow, 22).Value If strTYP = "CLR" Then xlsbookx.Sheets(LastSheet).Cells(iCount, 16).NumberFormatLocal = "0.0000%" Else xlsbookx.Sheets(LastSheet).Cells(iCount, 16).NumberFormatLocal = "0%" End If If xlsbook.Sheets(1).Cells(iRow, 23).Value <> "0%" Then xlsbookx.Sheets(LastSheet).Cells(iCount, 18).Value = xlsbook.Sheets(1).Cells(iRow, 23).Value xlsbookx.Sheets(LastSheet).Cells(iCount, 19).Value = xlsbook.Sheets(1).Cells(iRow, 24).Value strVAT = "Y" End If iRow = iRow + 1 iCount = iCount + 1 strCustNew = Trim(xlsbook.Sheets(1).Cells(iRow, 8).Value) If strCustNew <> "" Then strCustNameNew = Trim(xlsbook.Sheets(1).Cells(iRow, 9).Value) strParentNew = Trim(xlsbook.Sheets(1).Cells(iRow, 10).Value) strCURNew = Trim(xlsbook.Sheets(1).Cells(iRow, 17).Value) End If Loop '---E1 LastSheet = xlsbookx.Sheets.Count If (LastSheet > 1) And (iCount > 8) Then '---B1 ' '--- Total ' xlsbookx.Sheets(LastSheet).Cells(iCount, 17).Value = "=SUM(Q8:Q" & iCount - 1 & ")" If strVAT = "Y" Then xlsbookx.Sheets(LastSheet).Cells(7, 18).Value = "VAT %" xlsbookx.Sheets(LastSheet).Cells(7, 19).Value = "Rebate Amount With VAT" xlsbookx.Sheets(LastSheet).Cells(iCount, 19).Value = "=SUM(S8:S" & iCount - 1 & ")" End If End If '---E1 ' '--- Delete The First Sheet. ' Application.DisplayAlerts = False xlsbookx.Sheets("P00523SUM").Delete Application.DisplayAlerts = True ' '--- Save C:/TEMP/MIS/Report/P00523.xls. ' filen = "C:/TEMP/MIS/Report/P00523/" + strCust + "_Rebate_" + Format(Date, "yyyymmdd") + Format(Time, "hhmmss") + ".xls" xlsbookx.SaveAs (filen) xlsbookx.Close SaveChanges:=True ' '--- Handle Excel 2009.05.13 ' UPDExcel filen, strCust, strOPT, strVAT, Str(iCount) Set xlsbookx = Nothing xlsbook.Close SaveChanges:=False Set xlsbook = Nothing ' '--- Quit ' Application.Quit End Sub Function myMONStr(ByVal myMON As String) As String Dim xxi As Integer Dim xxstr As String xxi = CInt(Val(Mid(myMON, 5, 2))) xxstr = "***" Select Case xxi Case 1 xxstr = "January" Case 2 xxstr = "February" Case 3 xxstr = "March" Case 4 xxstr = "April" Case 5 xxstr = "May" Case 6 xxstr = "June" Case 7 xxstr = "July" Case 8 xxstr = "August" Case 9 xxstr = "September" Case 10 xxstr = "October" Case 11 xxstr = "November" Case 12 xxstr = "December" End Select myMONStr = xxstr End Function Private Sub UPDExcel(FileN1 As String, FileCUS As String, FileOPT As String, FileVAT As String, FileRow As Integer) Dim xlsFile1 As Excel.Workbook Dim xlsFile2 As Excel.Workbook Dim FileN2 As String Dim strJOB1 As String Dim StrJOB2 As String Dim dstrCust As String Dim dstrCol As String Dim dstr1 As String Dim AryJOB(10) As String Dim iAry As Integer Dim diRow1 As Integer Dim diii As Integer Dim diSheet As Integer Dim dLastSheet As Integer Dim dVAT As Double Dim dAMTVAT As Double diRow1 = CInt(FileRow) Application.ScreenUpdating = False ' Set xlsFile1 = Workbooks.Open(Filename:=FileN1, UpdateLinks:="3") diSheet = 1 xlsFile1.Sheets(diSheet).Select If FileVAT = "Y" Then ' '--- 如果计算VAT,则,确保全部计算VAT. ' diRow1 = 8 strJOB1 = Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 9).Value) Do While strJOB1 <> "" dVAT = Val(Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 18).Value)) dAMTVAT = Val(Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 19).Value)) If (dVAT = 0) And (dAMTVAT = 0) Then xlsFile1.Sheets(diSheet).Cells(diRow1, 18).Value = 0 xlsFile1.Sheets(diSheet).Cells(diRow1, 19).Value = xlsFile1.Sheets(diSheet).Cells(diRow1, 17).Value End If diRow1 = diRow1 + 1 strJOB1 = Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 9).Value) Loop End If ' '--- 画线. ' If FileVAT = "Y" Then dstrCol = "S" Else dstrCol = "Q" End If If diRow1 > 8 Then xlsFile1.Sheets(diSheet).Range("A7:" + dstrCol + Trim(Str(diRow1 - 1))).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With dstrCol = "Q" xlsFile1.Sheets(diSheet).Range(dstrCol + Trim(Str(diRow1))).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With If FileVAT = "Y" Then dstrCol = "S" xlsFile1.Sheets(diSheet).Range(dstrCol + Trim(Str(diRow1))).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End If ' If FileVAT = "Y" Then ' '--- 列宽 ' xlsFile1.Sheets(diSheet).Range("R8:R65536").NumberFormat = "0% " xlsFile1.Sheets(diSheet).Range("S8:S65536").NumberFormat = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ " xlsFile1.Sheets(diSheet).Columns("R:R").ColumnWidth = 6 xlsFile1.Sheets(diSheet).Columns("S:S").ColumnWidth = 14 ' '--- 页面缩放 ' xlsFile1.Sheets(diSheet).PageSetup.Zoom = 54 Else xlsFile1.Sheets(diSheet).PageSetup.Zoom = 58 End If Application.Goto Reference:="R2C1" End If If (FileOPT = "A") Then ' '--- 分页 ' xlsFile1.Sheets(diSheet).Select diRow1 = 8 iAry = 0 For diii = 0 To 10 AryJOB(diii) = "" Next strJOB1 = Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 9).Value) Do While strJOB1 <> "" StrJOB2 = Mid(strJOB1, 1, 3) ' '--- XH & WH 为相同类型,无须分页. 2009.05.14 ' If Mid(StrJOB2, 3, 1) = "W" Then Mid(StrJOB2, 3, 1) = "X" End If diii = 0 Do While diii <= 10 If (AryJOB(diii) = StrJOB2) Then diii = 11 Else If (AryJOB(diii) = "") Then AryJOB(diii) = StrJOB2 iAry = diii diii = 11 End If End If diii = diii + 1 Loop diRow1 = diRow1 + 1 strJOB1 = Trim(xlsFile1.Sheets(diSheet).Cells(diRow1, 9).Value) Loop If iAry > 0 Then diii = 0 Do While AryJOB(diii) <> "" dLastSheet = xlsFile1.Sheets.Count xlsFile1.Sheets(diSheet).Copy After:=xlsFile1.Sheets(dLastSheet) dLastSheet = xlsFile1.Sheets.Count xlsFile1.Sheets(dLastSheet).Name = FileCUS + "-" + AryJOB(diii) xlsFile1.Sheets(dLastSheet).Select diRow1 = 8 strJOB1 = Trim(xlsFile1.Sheets(dLastSheet).Cells(diRow1, 9).Value) Do While strJOB1 <> "" StrJOB2 = Mid(strJOB1, 1, 3) '2009.05.14 If Mid(StrJOB2, 3, 1) = "W" Then Mid(StrJOB2, 3, 1) = "X" End If If StrJOB2 <> AryJOB(diii) Then xlsFile1.Sheets(dLastSheet).Cells(diRow1, 1).EntireRow.Delete diRow1 = diRow1 - 1 End If diRow1 = diRow1 + 1 strJOB1 = Trim(xlsFile1.Sheets(dLastSheet).Cells(diRow1, 9).Value) Loop diii = diii + 1 Loop End If xlsFile1.Sheets(diSheet).Select End If ' '--- Split ' FileN2 = "C:/TEMP/MIS/Report/P00523/TMP0052303.xls" If Len(Dir(FileN2, vbDirectory)) > 0 Then Application.ScreenUpdating = False Set xlsFile2 = Workbooks.Open(Filename:=FileN2) xlsFile1.Sheets(diSheet).Activate diRow1 = CInt(FileRow) diRow2 = 1 dstrCust = Trim(xlsFile2.Sheets(1).Cells(diRow2, 1).Value) Do While dstrCust <> "" If (dstrCust = FileCUS) Then diRow1 = diRow1 + 2 xlsFile1.Sheets(diSheet).Cells(diRow1, 13).Value = Trim(xlsFile2.Sheets(1).Cells(diRow2, 5).Value) xlsFile1.Sheets(diSheet).Cells(diRow1, 16).Value = Trim(xlsFile2.Sheets(1).Cells(diRow2, 4).Value) xlsFile1.Sheets(diSheet).Cells(diRow1, 17).Value = Trim(xlsFile2.Sheets(1).Cells(diRow2, 7).Value) 'Format xlsFile1.Sheets(diSheet).Rows(diRow1).RowHeight = 38 dstr1 = "M" + Trim(Str(diRow1)) + ":P" + Trim(Str(diRow1 + 100)) xlsFile1.Sheets(diSheet).Range(dstr1).ClearFormats dstr1 = "M" + Trim(Str(diRow1)) + ":O" + Trim(Str(diRow1)) xlsFile1.Sheets(diSheet).Range(dstr1).Select Selection.WrapText = True Selection.MergeCells = True dstr1 = "M" + Trim(Str(diRow1)) + ":Q" + Trim(Str(diRow1)) xlsFile1.Sheets(diSheet).Range(dstr1).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Selection.Font.Name = "Arial" Selection.Font.Bold = True End If diRow2 = diRow2 + 1 dstrCust = Trim(xlsFile2.Sheets(1).Cells(diRow2, 1).Value) Loop dstr1 = "Q" + Trim(Str(diRow1 + 1)) xlsFile1.Sheets(diSheet).Range(dstr1).Select ' '--- Close file. ' xlsFile2.Close SaveChanges:=False Set xlsFile2 = Nothing End If ' '--- Save file. ' xlsFile1.Close SaveChanges:=True Set xlsFile1 = Nothing End Sub