Private Sub nProcessPnt(iType As String) 'Print Line data
    On Error GoTo ErrHandling
   
    Screen.MousePointer = 11
   
    Dim myworkbook As Excel.Workbook
    Dim myworksheet As Excel.Worksheet
    Dim myworksheet2 As Excel.Worksheet
    Dim iRangeTmp As Excel.Range

 

    If Not RptXls Is Nothing Then
        If RptXls.Workbooks.count = 0 Then RptXls.Application.Quit
    End If
    Set RptXls = Nothing
    Set RptXls = CreateObject("excel.application")
    ExcelStatus = True
   
    RptXls.Visible = False
    If iType = "0" Then
        RptXls.Workbooks.Open FileName:=App.Path & "\rpt\OQC品質抽樣月報.xls", ReadOnly:=True
    Else
        RptXls.Workbooks.Open FileName:=App.Path & "\rpt\OQC品質抽樣月報.xls"
    End If

 

    RptXls.Application.DisplayAlerts = False
    Set myworkbook = RptXls.ActiveWorkbook
    Set myworksheet = myworkbook.Worksheets("sheet1")
    Set iRangeTmp = RptXls.ActiveCell
    myworksheet.Rows("1:1").HorizontalAlignment = xlCenter
   
    With grdData
        .Row = 0
        .Col = 0
        .RowSel = grdData.Rows - 1
        .ColSel = grdData.Cols - 1
         Clipboard.Clear
         Clipboard.SetText .Clip
         Clipboard.GetData
         myworksheet.Range("A3").Select
         myworksheet.Paste
    End With
    With grdData2
        .Row = 0
        .Col = grdData2.Cols - 1
        .RowSel = grdData2.Rows - 1
        .ColSel = grdData2.Cols - 1
         Clipboard.Clear
         Clipboard.SetText .Clip
         Clipboard.GetData
         myworksheet.Range("F4").Select
         myworksheet.Paste
    End With
    With grdData1
        .Row = 0
        .Col = 0
        .RowSel = grdData1.Rows - 1
        .ColSel = grdData1.Cols - 1
         Clipboard.Clear
         Clipboard.SetText .Clip
         Clipboard.GetData
         myworksheet.Range("A16").Select
         myworksheet.Paste
    End With
    With grdData4
        .Row = 0
        .Col = 0
        .RowSel = grdData4.Rows - 1
        .ColSel = grdData4.Cols - 1
         Clipboard.Clear
         Clipboard.SetText .Clip
         Clipboard.GetData
         myworksheet.Range("A22").Select
         myworksheet.Paste
    End With
   
    '將sheet2設為目前sheet add by mandy 2002/11/19
    Set myworksheet2 = myworkbook.Worksheets("Sheet2")
    myworkbook.Sheets("Sheet2").Select
    With grdData3
        .Row = 0
        .Col = 0
        .RowSel = grdData3.Rows - 1
        .ColSel = grdData3.Cols - 1
         Clipboard.Clear
         Clipboard.SetText .Clip
         Clipboard.GetData
         myworksheet2.Range("A1").Select
         myworksheet2.Paste
    End With
    '將C欄位全部置中對奇
'    myworksheet2.Columns("C:C").Select
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlBottom
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .ShrinkToFit = False
'        .MergeCells = False
'    End With
    
    Clipboard.Clear
   
    myworkbook.Sheets("Sheet1").Select

 

   
    Call nSetPrintField(iRangeTmp)   '設定WorkSheet欄位值
   
    'Modify by Natasha 2001/12/28
    With myworksheet.PageSetup   '每頁皆設定表頭
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = ""
        .RightHeader = "列印日期：&""Times New Roman,標準""&D" & Chr(10) & "&""新細明體,標準""頁次：&""Times New Roman,標準""&P/&N"
    End With
   
'    myworksheet.Columns("A:I").EntireColumn.AutoFit  '調整最適欄?    '為了報表美觀一點,加入此行,可調整最為適欄?
'    myworksheet.PageSetup.Orientation = xlLandscape  '橫印
    If iType = "1" Then     'Print
        dlgColor.Filter = "*.xls"
        dlgColor.FileName = ""
        dlgColor.ShowSave
        If dlgColor.FileName <> "" Then  '取消Save
            myworksheet.SaveAs dlgColor.FileName
            MsgBox gGetMessage("O1", "儲存"), vbInformation, Me.Caption
        End If
        myworkbook.Close
        If Not RptXls Is Nothing Then
            If RptXls.Workbooks.count = 0 Then RptXls.Application.Quit
        End If
        Set RptXls = Nothing
       
    Else                    'Preview
        RptXls.Visible = True
        RptXls.ActiveWindow.SelectedSheets.PrintPreview    '開啟Preview視窗
        Set RptXls = Nothing
    End If
       
    Screen.MousePointer = 0

 

    Exit Sub

 

ErrHandling:
    myworkbook.Close
    If Not RptXls Is Nothing Then
        If RptXls.Workbooks.count = 0 Then RptXls.Application.Quit
    End If
    Set RptXls = Nothing
    Screen.MousePointer = 0
    If Err = 20545 Then Exit Sub
    MsgBox gGetMessage("00", ""), vbExclamation, Me.Caption
    Exit Sub
End Sub