zhongwentushu.dob

VB的图书馆管理系统

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub cmdAll_Click()
    datPrimaryRS.Recordset.Filter = ""
    datPrimaryRS.Refresh
    SSTab1.Tab = 1
End Sub

Private Sub cmdCancel_Click()
    SSTab1.Tab = 1
End Sub

Private Sub cmdFilter_Click()
    Dim strFilter As String
    '生成filter字符串
    strFilter = ""
    If Trim(txtFields(14).Text) <> "" Then
        strFilter = "图书ID=" & Trim(txtFields(14).Text)
    End If
    If Trim(txtFields(16).Text) <> "" Then
        If strFilter = "" Then
            strFilter = "作者 like '%" & Trim(txtFields(16).Text) & "%'"
        Else
            strFilter = strFilter & " and 作者 like '%" & Trim(txtFields(16).Text) & "%'"
        End If
    End If
    If Not IsNull(DTPicker1(2).Value) Then
        If strFilter = "" Then
            strFilter = "登记日期 >= #" & Format(DTPicker1(2).Value, "yyyy-mm-dd") & "#"
        Else
            strFilter = strFilter & " and 登记日期 >= #" & Format(DTPicker1(2).Value, "yyyy-mm-dd") & "#"
        End If
    End If
    If Not IsNull(DTPicker1(3).Value) Then
        If strFilter = "" Then
            strFilter = "登记日期 <= #" & Format(DTPicker1(3).Value, "yyyy-mm-dd") & "#"
        Else
            strFilter = strFilter & " and 登记日期 <= #" & Format(DTPicker1(3).Value, "yyyy-mm-dd") & "#"
        End If
    End If
    If txtFields(15).Text <> "" Then
        If strFilter = "" Then
            strFilter = "书名 like '%" & txtFields(15).Text & "%'"
        Else
            strFilter = strFilter & " and 书名 like '%" & txtFields(15).Text & "%'"
        End If
    End If
    If DataCombo2.Text <> "" Then
        If strFilter = "" Then
            strFilter = "分类id=" & DataCombo2.BoundText
        Else
            strFilter = strFilter & " and 分类id=" & DataCombo2.BoundText
        End If
    End If
    datPrimaryRS.Recordset.Filter = ""               'adFilterNone
    datPrimaryRS.Recordset.Filter = strFilter
    SSTab1.Tab = 1
End Sub

Private Sub cmdPrint_Click()
    Dim oExcel As Object
    Dim oBook As Object
    Dim oSheet As Object
    Dim DataArray() As Variant
    Dim i, j, Num As Integer
    
    Screen.MousePointer = vbHourglass
    
    'Start a new workbook in Excel
    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Add
    
    'Create an array
    Num = datPrimaryRS.Recordset.RecordCount
    If Num = 0 Then
      MsgBox "发排数据为空。", vbInformation
      Exit Sub
    End If
    ReDim DataArray(1 To Num, 1 To 10) As Variant
    
    datPrimaryRS.Recordset.MoveFirst
    For i = 1 To Num
        For j = 1 To 10
            DataArray(i, j) = datPrimaryRS.Recordset.Fields(j - 1).Value
        Next
        datPrimaryRS.Recordset.MoveNext
    Next
    datPrimaryRS.Recordset.MoveFirst
    
    'Add headers to the worksheet on row 1
    Set oSheet = oBook.Worksheets(1)
    oSheet.Range("A1:J1").Select
    With oExcel.Selection
        .HorizontalAlignment = -4108
        .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    oSheet.Range("A1").Value = Format(Now(), "yyyy") & "年中文图书总帐"
    oSheet.Range("A2").Value = "总号"
    oSheet.Range("B2").Value = "分类"
    oSheet.Range("C2").Value = "书名"
    oSheet.Range("D2").Value = "作者"
    oSheet.Range("E2").Value = "出版单位"
    oSheet.Range("F2").Value = "单价"
    oSheet.Range("G2").Value = "册数"
    oSheet.Range("H2").Value = "出版日期"
    oSheet.Range("I2").Value = "登记日期"
    oSheet.Range("J2").Value = "备注"
    oSheet.Range("A2:J2").Select
    With oExcel.Selection
        .HorizontalAlignment = -4108
        .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With
    
    'Transfer the array to the worksheet starting at cell A2
    oSheet.Range("A3").Resize(Num, 10).Value = DataArray
    
    oSheet.Range("A2:J" & CStr(Num + 2)).Select
    oExcel.Selection.Borders(5).LineStyle = -4142
    oExcel.Selection.Borders(6).LineStyle = -4142
    With oExcel.Selection.Borders(7)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(8)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(9)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(10)
        .LineStyle = 1
        .Weight = 3
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(11)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    With oExcel.Selection.Borders(12)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = -4105
    End With
    
    oSheet.Range("E" & CStr(Num + 3)).Value = "合计"
    oSheet.Range("F" & CStr(Num + 3)).Formula = "=SUM(F3:F" & CStr(Num + 2) & ")"
    oSheet.Range("G" & CStr(Num + 3)).Formula = "=SUM(G3:G" & CStr(Num + 2) & ")"


    oSheet.Columns("A:A").EntireColumn.AutoFit
    oSheet.Columns("B:B").EntireColumn.AutoFit
    oSheet.Columns("C:C").EntireColumn.AutoFit
    oSheet.Columns("D:D").EntireColumn.AutoFit
    oSheet.Columns("E:E").EntireColumn.AutoFit
    oSheet.Columns("F:F").EntireColumn.AutoFit
    oSheet.Columns("G:G").EntireColumn.AutoFit
    oSheet.Columns("H:H").EntireColumn.AutoFit
    oSheet.Columns("I:I").EntireColumn.AutoFit
    oSheet.Columns("J:J").EntireColumn.AutoFit
    
    
    With oSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    oSheet.PageSetup.PrintArea = ""
    With oSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = oExcel.InchesToPoints(0.75)
        .RightMargin = oExcel.InchesToPoints(0.75)
        .TopMargin = oExcel.InchesToPoints(1)
        .BottomMargin = oExcel.InchesToPoints(1)
        .HeaderMargin = oExcel.InchesToPoints(0.5)
        .FooterMargin = oExcel.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = -4142
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = 2
        .Draft = False
        .PaperSize = 8    'A3
        .FirstPageNumber = -4105
        .Order = 1
        .BlackAndWhite = False
        .Zoom = 100
    End With
       
    oSheet.Range("A1").Select

    oExcel.Visible = True
    
    Screen.MousePointer = vbDefault
    
    Set oExcel = Nothing
    Set oBook = Nothing
    Set oSheet = Nothing
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdPrint1_Click()
    Dim strSQL As String
    Dim oWrd As Object
    
    Set oWrd = CreateObject("Word.Application")
    oWrd.Visible = True
    oWrd.Activate
    oWrd.Documents.Add

    With oWrd.ActiveDocument.PageSetup
        .TopMargin = 24
        .BottomMargin = 72
        .LeftMargin = 50
        .RightMargin = 361
        .PageWidth = 595.3
        .PageHeight = 841.9
    End With
    
    With oWrd.Selection
      
      With .ParagraphFormat
            .Alignment = 3
            .LineSpacingRule = 1
            .SpaceBefore = 0
            .SpaceAfter = 0
      End With
      
      .Font.Name = "宋体"
      .Font.Bold = True
      .Font.Size = 12
      .TypeText "图" & Format(txtFields(1).Text, "00000")
      .TypeParagraph
      
      .Font.Size = 10.5
      .Font.Bold = True
      
      With .ParagraphFormat
            .Alignment = 3
            .LineSpacingRule = 1
            .SpaceBefore = 6
            .SpaceAfter = 3
      End With

      .TypeText txtFields(3).Text
      .TypeParagraph
      
      With .ParagraphFormat
            .Alignment = 3
            .LineSpacingRule = 0
            .SpaceBefore = 0
            .SpaceAfter = 0
            .LeftIndent = 14.2

      End With
      
      .Font.Bold = False
      .TypeText txtFields(7).Text
      .TypeParagraph
      .TypeText txtFields(5).Text
      .TypeParagraph
      
      '部门
'      .ParagraphFormat.Alignment = 3
'      .ParagraphFormat.SpaceBefore = 24
'      .ParagraphFormat.LineSpacing = 20
'      .Font.Size = 11    '五号
'      .Font.Name = "宋体"
'      .Font.Bold = False
'      .TypeText "部门名称：" & Space(2) & DataCombo1.Text
'      .TypeParagraph
            
      
      .HomeKey unit:=6

    End With

    Set oWrd = Nothing
    

End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要忽略错误，注释掉下一行
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "Data error event hit err:" & Description
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  datPrimaryRS.Recordset.AddNew

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
  Dim lgNum As Long
  
  On Error GoTo DeleteErr
    Dim nYN As Byte
    
     nYN = MsgBox("您正准备删除当前记录。" & Chr(13) & Chr(13) & _
        "假如您单击“是”，您将不能撤消这个删除操作。" & Chr(13) & _
        "您确认删除这条记录吗?", vbExclamation + vbYesNo)
    
    If nYN = vbYes Then
      
      lgNum = datPrimaryRS.Recordset.AbsolutePosition
    
      cn.Execute " delete from 中文图书 where 图书id =" & txtFields(1).Text
      
      datPrimaryRS.Refresh
      datPrimaryRS.Recordset.AbsolutePosition = lgNum
      If datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveLast
      
    End If
  

  

    
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  On Error GoTo RefreshErr
  datPrimaryRS.Refresh
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr
  
  datPrimaryRS.Recordset.Fields("分类id") = DataCombo1.BoundText
  datPrimaryRS.Recordset.UpdateBatch adAffectAll
  
  
      Dim lgNum As Long


      lgNum = datPrimaryRS.Recordset.AbsolutePosition


      datPrimaryRS.Refresh
      datPrimaryRS.Recordset.AbsolutePosition = lgNum

  
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub



Private Sub UserDocument_Initialize()
    
    cn.Open pConn
    
    With rs
        .ActiveConnection = cn
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockOptimistic
        .Open "select a.图书ID, b.分类, a.书名, a.作者, a.出版单位, a.单价, a.册数, a.出版日期, a.登记日期, a.备注, a.页数, a.分类id from 中文图书 a LEFT JOIN 图书分类 b ON a.分类ID = b.分类ID order by 1"
    End With
    
    Set datPrimaryRS.Recordset = rs
    
'    With datPrimaryRS
'        .ConnectionString = pConn
'        .RecordSource = "select 图书ID, 分类ID, 书名, 作者, 出版单位, 单价, 册数, 出版日期, 登记日期, 备注, 页数 from 中文图书"
'        .Refresh
'    End With
    
    With Adodc1
        .ConnectionString = pConn
        .RecordSource = "图书分类"
        .Refresh
    End With
    
    With DataCombo1
        Set .DataSource = datPrimaryRS
        .DataField = "分类id"
        Set .RowSource = Adodc1
        .ListField = "分类"
        .BoundColumn = "分类id"
    End With

End Sub

Private Sub UserDocument_Terminate()
    rs.Close
    cn.Close
End Sub