form_query.frm

2008年版

        xlsheet.Cells(lop, 3) = .Item(numi).SubItems(10)
        xlsheet.Cells(lop, 4) = .Item(numi).SubItems(9)
        xlsheet.Cells(lop, 5) = .Item(numi).SubItems(11)
        xlsheet.Cells(lop, 6) = .Item(numi).SubItems(12)
        xlsheet.Cells(lop, 7) = .Item(numi).SubItems(15)
        
        lop = lop + 1
    Next numi
    
    Dim isum, iprint As Integer
    isum = .Count
        iprint = isum Mod 15
        If iprint <> 0 Then
            iprint = 15 - iprint
            For numj = 1 To iprint
                    xlsheet.Cells(lop, 1) = "'"
                    lop = lop + 1
            Next numj
        End If
 '打印空行
    
    End With
    
    xlapp.Visible = True
    'xlsheet.PrintOut '执行打印
    xlbook.Save '保存文件
    'xlapp.quit '退出Excel
    
    Screen.MousePointer = vbDefault
    Exit Sub
e:
    MsgBox Err.Description
    Screen.MousePointer = vbDefault
    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing
End Sub

Private Sub Command6_Click()
    On Error GoTo e:
        queryflag = "no"
    Dim xlapp As Object, xlbook As Object, xlsheet As Object
    Dim strSource, strDestination As String
    Dim lop As Integer
    Dim numi, numj As Integer
    'Dim xlbook As Excel.Workbook
    'Dim xlsheet As Excel.Worksheet
    
    Screen.MousePointer = vbHourglass
    
    Set xlapp = CreateObject("Excel.Application")
    xlapp.Visible = False
    
    If Right(App.Path, 1) = "\" Then
        strSource = App.Path & "excel\gridSC.xls"
        strDestination = App.Path & "excel\temp.xls"
    Else
        strSource = App.Path & "\excel\gridSC.xls"
        strDestination = App.Path & "\excel\temp.xls"
    End If
    
    FileCopy strSource, strDestination
    
    Set xlbook = xlapp.Workbooks.Open(strDestination)
   
    Set xlsheet = xlbook.Worksheets(1)
    lop = 4
    'For numj = 1 To ListView2.ColumnHeaders.Count
    'xlsheet.Cells(2, numj) = ListView2.ColumnHeaders.Item(numj).Text
    'Next numj
        With form_WenJian.ListView2.ListItems
    For numi = 1 To .Count
        'xlsheet.Cells(lop, 1) = .Item(numi)
        For numj = 3 To form_WenJian.ListView2.ColumnHeaders.Count - 2
            If (.Item(numi).SubItems(10) = "2") Then
                xlsheet.Cells(lop, numj - 2) = .Item(numi).SubItems(numj) '打印列
            End If '室藏判断
        Next numj
        If xlsheet.Cells(lop, 1) = "" Then
        Else
            lop = lop + 1
        End If
    Next numi
    End With
    
    xlapp.Visible = True
    'xlsheet.PrintOut '执行打印
    xlbook.Save '保存文件
    'xlapp.quit '退出Excel
    
    Screen.MousePointer = vbDefault
    Exit Sub
e:
    MsgBox Err.Description
    Screen.MousePointer = vbDefault
    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing
End Sub

Private Sub Command7_Click()
On Error GoTo e:
    Call Command1_Click
        queryflag = "no"
    Dim xlapp As Object, xlbook As Object, xlsheet As Object
    Dim strSource, strDestination As String
    Dim lop As Integer
    Dim numi, numj As Integer
    'Dim xlbook As Excel.Workbook
    'Dim xlsheet As Excel.Worksheet
    
    Screen.MousePointer = vbHourglass
    
    Set xlapp = CreateObject("Excel.Application")
    xlapp.Visible = False
    
    If Right(App.Path, 1) = "\" Then
        strSource = App.Path & "excel\gridGC.xls"
        strDestination = App.Path & "excel\temp.xls"
    Else
        strSource = App.Path & "\excel\gridGC.xls"
        strDestination = App.Path & "\excel\temp.xls"
    End If
    
    FileCopy strSource, strDestination
    
    Set xlbook = xlapp.Workbooks.Open(strDestination)
   
    Set xlsheet = xlbook.Worksheets(1)
    lop = 4
    'For numj = 1 To ListView2.ColumnHeaders.Count
    'xlsheet.Cells(2, numj) = ListView2.ColumnHeaders.Item(numj).Text
    'Next numj
        With form_WenJian.ListView2.ListItems
    For numi = 1 To .Count
        'xlsheet.Cells(lop, 1) = .Item(numi)
        For numj = 3 To form_WenJian.ListView2.ColumnHeaders.Count - 2
            If Not (.Item(numi).SubItems(10) = "2") Then
                xlsheet.Cells(lop, numj - 2) = .Item(numi).SubItems(numj) '打印列
            End If '馆藏判断
        Next numj
        If xlsheet.Cells(lop, 1) = "" Then
        Else
            lop = lop + 1
        End If
    Next numi
    End With
    
    xlapp.Visible = True
    'xlsheet.PrintOut '执行打印
    xlbook.Save '保存文件
    'xlapp.quit '退出Excel
    
    Screen.MousePointer = vbDefault
    Exit Sub
e:
    MsgBox Err.Description
    Screen.MousePointer = vbDefault
    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing

End Sub

Private Sub Command8_Click()
 On Error GoTo e:
    JG = "y"
    Call Command1_Click
        queryflag = "no"
        query = "file"
    Dim xlapp As Object, xlbook As Object, xlsheet As Object
    Dim strSource, strDestination As String
    Dim lop As Integer
    Dim numi, numj As Integer
    'Dim xlbook As Excel.Workbook
    'Dim xlsheet As Excel.Worksheet
    
    Screen.MousePointer = vbHourglass
    
    Set xlapp = CreateObject("Excel.Application")
    xlapp.Visible = False
    
    If Right(App.Path, 1) = "\" Then
        strSource = App.Path & "excel\gridSC.xls"
        strDestination = App.Path & "excel\temp.xls"
    Else
        strSource = App.Path & "\excel\gridSC.xls"
        strDestination = App.Path & "\excel\temp.xls"
    End If
    
    FileCopy strSource, strDestination
    
    Set xlbook = xlapp.Workbooks.Open(strDestination)
   
    Set xlsheet = xlbook.Worksheets(1)
    lop = 4
    'For numj = 1 To ListView2.ColumnHeaders.Count
    'xlsheet.Cells(2, numj) = ListView2.ColumnHeaders.Item(numj).Text
    'Next numj
    If form_Query.Text6.text <> "" And form_Query.Text6.text = form_Query.Text7.text Then
        xlsheet.Cells(2, 2) = form_Query.Text6.text
    End If
    If form_Query.Combo1.text <> "" Then
        xlsheet.Cells(2, 4) = form_Query.Combo1.text
    End If
    If form_Query.Text8.text <> "" Then
        xlsheet.Cells(2, 7) = form_Query.Text8.text
    End If
    
        With form_WenJian.ListView2.ListItems

    For numi = 1 To .Count
'        xlsheet.Cells(lop, 1) = .Item(numi).SubItems(3)
'        For numj = 4 To form_WenJian.ListView2.ColumnHeaders.Count - 6
'                xlsheet.Cells(lop, numj - 2) = .Item(numi).SubItems(numj) '打印列
'        Next numj
        xlsheet.Cells(lop, 1) = .Item(numi).SubItems(2)
        xlsheet.Cells(lop, 2) = .Item(numi).SubItems(8)
        xlsheet.Cells(lop, 3) = .Item(numi).SubItems(10)
        xlsheet.Cells(lop, 4) = .Item(numi).SubItems(9)
        xlsheet.Cells(lop, 5) = .Item(numi).SubItems(11)
        xlsheet.Cells(lop, 6) = .Item(numi).SubItems(12)
        xlsheet.Cells(lop, 7) = .Item(numi).SubItems(15)
        lop = lop + 1
    Next numi
    
    Dim isum, iprint As Integer
    isum = .Count
    
        iprint = isum Mod 15
        If iprint <> 0 Then
            iprint = 15 - iprint
            For numj = 1 To iprint
                    xlsheet.Cells(lop, 1) = "'"
                    lop = lop + 1
            Next numj
        End If
 '打印空行
    
    End With
    
    xlapp.Visible = True
    'xlsheet.PrintOut '执行打印
    xlbook.Save '保存文件
    'xlapp.quit '退出Excel
    
    Screen.MousePointer = vbDefault
    Exit Sub
e:
    MsgBox Err.Description
    Screen.MousePointer = vbDefault
    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing
End Sub

Private Sub DTPicker1_Change()
    flagDate = 1
End Sub

Private Sub DTPicker2_Change()
    flagDate = 1
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    SendKeys "{tab}"
    KeyAscii = 0
    End If
End Sub

Private Sub Form_Load()
'MsgBox query

If query = "file" Then
    Label8.Caption = "室编件号"
    'Label8.ForeColor = RGB(200, 0, 0)
    Command1.Left = 1305
    Command1.Top = 4815
Else
    Command1.Left = 2745
    Command1.Top = 4185
    
    Label12.Visible = False
    Text8.Visible = False
    Label9.Visible = False
    Label10.Visible = False
    Text6.Visible = False
    Combo1.Visible = False
    Command6.Visible = False
    Command7.Visible = False
    Text7.Visible = False
    Label11.Visible = False
    Command2.Visible = False
    Command8.Visible = False
End If
Dim k As Integer
backColor = bgColor
Label4.Caption = form_AnJuan.Label4.Caption + "卷内文件查询"
If query = "file" Then
    Label4.Caption = "归档文件查询"
End If
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text4.text = ""
Text5.text = ""
Text6.text = ""
Text7.text = ""

Combo1.AddItem ""
Combo1.AddItem "1--永久"
Combo1.AddItem "2--长期"
Combo1.AddItem "3--短期"
Combo1.ListIndex = 0

 'DTPicker1.Value = Date
 DTPicker2.Value = Date

Select Case form_AnJuan.List1.ListIndex
    Case 0
        'MsgBox "文书档案"                   '0
        Label7.Visible = True
        Text4.Visible = True
    Case 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24
        'MsgBox "专业档案"                     '1
    Case 10
        '会计档案
        Label3.Visible = False
        Text3.Visible = False
    Case 11
        '实物档案
    Case 12
        '电子档案
    Case 7
        'MsgBox "---照片档案"                 '2
        Label7.Caption = "拍摄者"
        Label5.Caption = "拍摄时间"
        Label7.Visible = True
        Text4.Visible = True
    Case 8, 9
        'MsgBox "---音、视频档案"         '3
        Label7.Caption = "拍摄者"
        Label5.Caption = "拍摄时间"
        Label7.Visible = True
        Text4.Visible = True
    Case 2, 3, 4, 5
        'MsgBox "科技档案"                        '19
    Case Else
        'Unload Me
    End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
    flagDate = 0 '日期控件标志赋值
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
        KeyAscii = 0
        MsgBox "请输入数字!", 48, ""
    End If
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
    If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
        KeyAscii = 0
        MsgBox "请输入数字!", 48, ""
    End If
End Sub