Excel VBA Sample 3 --- P00517

Private Sub Workbook_open()''--- Define variables.' Dim xlsbook As Excel.Workbook Dim xlsbook2 As Excel.Workbook Dim xlsbook3 As Excel.Workbook Dim xlsbookx As Excel.Workbook Dim filen As String Dim strData1 As String Dim strData3 As String Dim LastSheet As Integer Dim F2NRN As String Dim F2OED As String Dim F2CUS As String Dim F2CNM As String Dim F2SJT As String Dim F2CUR As String Dim F2UOM As String Dim F2VAT As Single Dim F2STA As Single Dim F2SCA As Single Dim F2GTA As Single Dim F2TQ As Single Dim F2SD1 As String Dim F2SD2 As String Dim F2TXU As String Dim F2APU As String Dim F2CPNE As String Dim F2CPNC As String Dim F2DOP As String Dim F2CUR2 As String Dim F2EXR As Single Dim F2GA2 As Single Dim F2OFN As String Dim F2OFU As String Dim F2OFD As String Dim F2CAD1 As String Dim F2CAD2 As String Dim F2CTEL As String Dim F1ITM As String Dim F3ITM As String Dim F2CPNHKC As String Dim F2CPNXHC As String Dim F2CPNWHC As String Dim F2CPNYXC As String Dim F2CRENG As String Dim F2CRCHN As String Dim F2DRENG As String Dim F2DRCHN As String Dim iRow1 As Integer Dim iRow2 As Integer Dim iRow3 As Integer Dim iRowA As Integer Dim iPage As Integer Dim newPage As Boolean Dim newRow As Boolean Dim strSheetName As String''--- Handle C:/TEMP/MIS/Report/TMP0051701.xls' Application.ScreenUpdating = False' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00517/TMP0051701.xls") xlsbook.Save xlsbook.Close''--- Handle C:/TEMP/MIS/Report/TMP0051702.xls' Application.ScreenUpdating = False' Set xlsbook2 = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00517/TMP0051702.xls") Set xlsbook3 = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00517/TMP0051703.xls")''--- Handle C:/TEMP/MIS/Report/P00517_Form.xls.' Application.ScreenUpdating = False Set xlsbookx = Workbooks.Open(Filename:="C:/TEMP/MIS/Program/P00517_Form.xls", UpdateLinks:="3") '2009.08.21 Set Form Title Name F2CRENG = Trim(xlsbookx.Sheets(1).Cells(20, 4).Value) F2CRCHN = Trim(xlsbookx.Sheets(1).Cells(21, 4).Value) F2DRENG = Trim(xlsbookx.Sheets(1).Cells(22, 4).Value) F2DRCHN = Trim(xlsbookx.Sheets(1).Cells(23, 4).Value) 'Clear data xlsbookx.Sheets(1).Cells(20, 4).ClearContents xlsbookx.Sheets(1).Cells(21, 4).ClearContents xlsbookx.Sheets(1).Cells(22, 4).ClearContents xlsbookx.Sheets(1).Cells(23, 4).ClearContents '2009.07.31 set chinese name F2CPNHKC = Trim(xlsbookx.Sheets(1).Cells(25, 4).Value) F2CPNXHC = Trim(xlsbookx.Sheets(1).Cells(26, 4).Value) F2CPNWHC = Trim(xlsbookx.Sheets(1).Cells(27, 4).Value) F2CPNYXC = Trim(xlsbookx.Sheets(1).Cells(28, 4).Value)'Clear data xlsbookx.Sheets(1).Cells(25, 4).ClearContents xlsbookx.Sheets(1).Cells(26, 4).ClearContents xlsbookx.Sheets(1).Cells(27, 4).ClearContents xlsbookx.Sheets(1).Cells(28, 4).ClearContents''--- Handle C:/TEMP/MIS/Report/TMP0051701.xls' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/P00517/TMP0051701.xls")''--- Default variable' F2NRN = Trim(xlsbook2.Sheets(1).Cells(2, 1).Value) iRow2 = 2 newPage = False Do While F2NRN <> "" '---B1 '2009.09.17 F2NRN = Trim(xlsbook2.Sheets(1).Cells(iRow2, 1).Value) F2OED = Trim(xlsbook2.Sheets(1).Cells(iRow2, 2).Value) F2CUS = Trim(xlsbook2.Sheets(1).Cells(iRow2, 3).Value) F2CNM = Trim(xlsbook2.Sheets(1).Cells(iRow2, 4).Value) F2SJT = Trim(xlsbook2.Sheets(1).Cells(iRow2, 5).Value) F2CUR = Trim(xlsbook2.Sheets(1).Cells(iRow2, 6).Value) F2UOM = Trim(xlsbook2.Sheets(1).Cells(iRow2, 7).Value) F2VAT = xlsbook2.Sheets(1).Cells(iRow2, 8).Value F2STA = xlsbook2.Sheets(1).Cells(iRow2, 9).Value F2SCA = xlsbook2.Sheets(1).Cells(iRow2, 10).Value F2GTA = xlsbook2.Sheets(1).Cells(iRow2, 11).Value F2TQ = xlsbook2.Sheets(1).Cells(iRow2, 12).Value F2SD1 = Trim(xlsbook2.Sheets(1).Cells(iRow2, 13).Value) F2SD2 = Trim(xlsbook2.Sheets(1).Cells(iRow2, 14).Value) F2TXU = Trim(xlsbook2.Sheets(1).Cells(iRow2, 15).Value) F2APU = Trim(xlsbook2.Sheets(1).Cells(iRow2, 16).Value) F2CPNE = Trim(xlsbook2.Sheets(1).Cells(iRow2, 17).Value) F2CPNC = Trim(xlsbook2.Sheets(1).Cells(iRow2, 18).Value) F2DOP = Trim(xlsbook2.Sheets(1).Cells(iRow2, 19).Value) F2CUR2 = Trim(xlsbook2.Sheets(1).Cells(iRow2, 20).Value) F2EXR = xlsbook2.Sheets(1).Cells(iRow2, 21).Value F2GA2 = xlsbook2.Sheets(1).Cells(iRow2, 22).Value F2OFN = Trim(xlsbook2.Sheets(1).Cells(iRow2, 23).Value) F2OFU = Trim(xlsbook2.Sheets(1).Cells(iRow2, 24).Value) F2OFD = Trim(xlsbook2.Sheets(1).Cells(iRow2, 25).Value) F2CAD1 = Trim(xlsbook2.Sheets(1).Cells(iRow2, 26).Value) F2CAD2 = Trim(xlsbook2.Sheets(1).Cells(iRow2, 27).Value) F2CTEL = Trim(xlsbook2.Sheets(1).Cells(iRow2, 28).Value)'2009.08.21 Set Form Title Name If Mid(F2NRN, 6, 1) = "D" Then xlsbookx.Sheets(1).Cells(1, 7).Value = F2DRENG xlsbookx.Sheets(1).Cells(2, 7).Value = F2DRENG End If If Mid(F2NRN, 6, 1) = "C" Then xlsbookx.Sheets(1).Cells(1, 7).Value = F2CRENG xlsbookx.Sheets(1).Cells(2, 7).Value = F2CRCHN End If If Mid(F2NRN, 4, 2) = "HK" Then F2CPNC = F2CPNHKC End If If Mid(F2NRN, 4, 2) = "XH" Then F2CPNC = F2CPNXHC End If If Mid(F2NRN, 4, 2) = "WH" Then F2CPNC = F2CPNWHC End If If Mid(F2NRN, 4, 2) = "YX" Then F2CPNC = F2CPNYXC End If xlsbookx.Sheets(1).Cells(1, 2).Value = F2CPNE xlsbookx.Sheets(1).Cells(2, 2).Value = F2CPNC xlsbookx.Sheets(1).Cells(7, 2).Value = F2CNM xlsbookx.Sheets(1).Cells(4, 8).Value = F2NRN xlsbookx.Sheets(1).Cells(7, 8).Value = Mid(F2OED, 1, 4) + "-" + Mid(F2OED, 5, 2) + "-" + Mid(F2OED, 7, 2) If F2CUS = "N/A" Then xlsbookx.Sheets(1).Cells(10, 8).Value = " " Else xlsbookx.Sheets(1).Cells(10, 8).Value = F2CUS End If xlsbookx.Sheets(1).Cells(13, 8).Value = F2SJT ' xlsbookx.Sheets(1).Cells(19, 2).Value = F2UOM xlsbookx.Sheets(1).Cells(19, 8).Value = F2DOP xlsbookx.Sheets(1).Cells(19, 10).Value = F2CUR xlsbookx.Sheets(1).Cells(59, 5).Value = F2SD1 xlsbookx.Sheets(1).Cells(60, 5).Value = F2SD2 xlsbookx.Sheets(1).Cells(64, 1).Value = F2OFU xlsbookx.Sheets(1).Cells(65, 2).Value = F2OFN xlsbookx.Sheets(1).Cells(65, 7).Value = F2APU xlsbookx.Sheets(1).Cells(65, 9).Value = F2TXU iRow1 = 2 iRowA = 20 iPage = 0 LastSheet = 1 newPage = True strData1 = Trim(xlsbook.Sheets(1).Cells(iRow1, 1).Value) Do While strData1 <> "" '---B2 F1ITM = xlsbook.Sheets(1).Cells(iRow1, 2).Value If strData1 = F2NRN Then '---B3 iRow3 = 2 newRow = True F3ITM = xlsbook3.Sheets(1).Cells(iRow3, 2).Value strData3 = Trim(xlsbook3.Sheets(1).Cells(iRow3, 1).Value) Do While strData3 <> "" '---B4 If (strData3 = F2NRN) And (F1ITM = F3ITM) Then '---B5 If newPage Then newPage = False Application.ScreenUpdating = False LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets("P00517").Copy After:=xlsbookx.Sheets(LastSheet) If iPage = 0 Then strSheetName = F2CUS Else strSheetName = F2CUS + "-" + Trim(Str(iPage)) End If'---2009.08.28 strSheetName = Replace(strSheetName, "/", "-") LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets(LastSheet).Name = strSheetName xlsbookx.Sheets(LastSheet).Select End If If newRow Then newRow = False xlsbookx.Sheets(LastSheet).Cells(iRowA, 1).Value = xlsbook.Sheets(1).Cells(iRow1, 9).Value xlsbookx.Sheets(LastSheet).Cells(iRowA, 2).Value = xlsbook.Sheets(1).Cells(iRow1, 10).Value xlsbookx.Sheets(LastSheet).Cells(iRowA, 8).Value = xlsbook.Sheets(1).Cells(iRow1, 11).Value xlsbookx.Sheets(LastSheet).Cells(iRowA, 10).Value = xlsbook.Sheets(1).Cells(iRow1, 12).Value End If xlsbookx.Sheets(LastSheet).Cells(iRowA, 4).Value = xlsbook3.Sheets(1).Cells(iRow3, 4).Value If (xlsbook3.Sheets(1).Cells(iRow3, 3).Value = 3) And (xlsbook.Sheets(1).Cells(iRow1, 13).Value > 0) Then xlsbookx.Sheets(LastSheet).Cells(iRowA, 10).Value = xlsbook.Sheets(1).Cells(iRow1, 13).Value 'the surcharge End If iRowA = iRowA + 1 If iRowA >= 50 Then newPage = True iRowA = 20 iPage = iPage + 1 End If End If '---E5 iRow3 = iRow3 + 1 strData3 = Trim(xlsbook3.Sheets(1).Cells(iRow3, 1).Value) F3ITM = xlsbook3.Sheets(1).Cells(iRow3, 2).Value Loop '---E4 iRowA = iRowA + 1 newRow = True End If '---E3 iRow1 = iRow1 + 1 newRow = True strData1 = Trim(xlsbook.Sheets(1).Cells(iRow1, 1).Value) Loop '---E2 xlsbookx.Sheets(LastSheet).Cells(52, 8).Value = " " xlsbookx.Sheets(LastSheet).Cells(52, 9).Value = " " xlsbookx.Sheets(LastSheet).Cells(52, 10).Value = " " xlsbookx.Sheets(LastSheet).Cells(53, 8).Value = "Total:" xlsbookx.Sheets(LastSheet).Cells(53, 9).Value = F2CUR xlsbookx.Sheets(LastSheet).Cells(53, 10).Value = F2STA + F2SCA If F2VAT = 0 Then xlsbookx.Sheets(LastSheet).Cells(54, 8).Value = " " xlsbookx.Sheets(LastSheet).Cells(54, 9).Value = " " xlsbookx.Sheets(LastSheet).Cells(54, 10).Value = " " xlsbookx.Sheets(LastSheet).Cells(55, 8).Value = " " xlsbookx.Sheets(LastSheet).Cells(55, 9).Value = " " xlsbookx.Sheets(LastSheet).Cells(55, 10).Value = " " Else xlsbookx.Sheets(LastSheet).Cells(54, 8).Value = "VAT " & Trim(Str(F2VAT)) & "%:" xlsbookx.Sheets(LastSheet).Cells(54, 9).Value = F2CUR xlsbookx.Sheets(LastSheet).Cells(54, 10).Value = (F2STA + F2SCA) * F2VAT / 100 xlsbookx.Sheets(LastSheet).Cells(55, 8).Value = "With VAT:" xlsbookx.Sheets(LastSheet).Cells(55, 9).Value = F2CUR xlsbookx.Sheets(LastSheet).Cells(55, 10).Value = F2GTA End If If (F2CUR2 <> F2CUR) And (F2CUR2 <> "") Then xlsbookx.Sheets(LastSheet).Cells(56, 8).Value = "Rate:" xlsbookx.Sheets(LastSheet).Cells(56, 10).Value = F2EXR xlsbookx.Sheets(LastSheet).Cells(57, 8).Value = "Grand-Total:" xlsbookx.Sheets(LastSheet).Cells(57, 9).Value = F2CUR2 xlsbookx.Sheets(LastSheet).Cells(57, 10).Value = F2GA2 Else If F2VAT = 0 Then xlsbookx.Sheets(LastSheet).Cells(53, 8).Value = " " xlsbookx.Sheets(LastSheet).Cells(53, 9).Value = " " xlsbookx.Sheets(LastSheet).Cells(53, 10).Value = " " End If xlsbookx.Sheets(LastSheet).Cells(56, 8).Value = " " xlsbookx.Sheets(LastSheet).Cells(56, 9).Value = " " xlsbookx.Sheets(LastSheet).Cells(56, 10).Value = " " xlsbookx.Sheets(LastSheet).Cells(57, 8).Value = "Grand-Total:" xlsbookx.Sheets(LastSheet).Cells(57, 9).Value = F2CUR xlsbookx.Sheets(LastSheet).Cells(57, 10).Value = F2GTA End If iRow2 = iRow2 + 1 F2NRN = Trim(xlsbook2.Sheets(1).Cells(iRow2, 1).Value) Loop '---E1 xlsbook.Close SaveChanges:=False xlsbook2.Close SaveChanges:=False xlsbook3.Close SaveChanges:=False Set xlsbook = Nothing Set xlsbook2 = Nothing Set xlsbook3 = Nothing ''--- Delete The First Sheet.' Application.DisplayAlerts = False xlsbookx.Sheets("P00517").Delete Application.DisplayAlerts = True''--- Save C:/TEMP/MIS/Report/P00517.xls.' xlsbookx.Sheets(1).Select filen = "C:/TEMP/MIS/Report/P00517/P00517.xls" xlsbookx.SaveAs (filen) xlsbookx.Close SaveChanges:=True '--- Re-open file Set xlsbookx = Workbooks.Open(filen)'--- Print to PDF. On Error Resume Next xlsbookx.ActiveSheet.PrintPreview' Application.ActivePrinter = "PDF995 on Ne00:" If Application.Dialogs(xlDialogPrinterSetup).Show Then xlsbookx.PrintOut Copies:=1 End If xlsbookx.Close SaveChanges:=False Set xlsbookx = Nothing''--- Quit'' Application.Quit If Application.Workbooks.Count = 1 Then Application.Quit Else Workbooks("P00517_Report.xls").Close End IfEnd Sub