jishuziliao.dob

VB的图书馆管理系统

      EndProperty
      _Version        =   393216
   End
   Begin MSAdodcLib.Adodc Adodc2 
      Height          =   330
      Left            =   4440
      Top             =   0
      Visible         =   0   'False
      Width           =   1890
      _ExtentX        =   3334
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   1
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc2"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
End
Attribute VB_Name = "JiShuZiLiao"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
  
  datPrimaryRS.Recordset.AddNew
  DTPicker1(0).Value = Format(Now(), "Short Date")
  DTPicker1(1).Value = Format(Now(), "Short Date")
  
  Exit Sub
AddErr:
  MsgBox Err.Description

End Sub

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

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

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  
    Dim nYN As Byte
    
     nYN = MsgBox("您正准备删除当前记录。" & Chr(13) & Chr(13) & _
        "假如您单击“是”，您将不能撤消这个删除操作。" & Chr(13) & _
        "您确认删除这条记录吗?", vbExclamation + vbYesNo)
    
    If nYN = vbYes Then
      With datPrimaryRS.Recordset
            If .EOF And .BOF Then Exit Sub
            .Delete
            .MoveNext
            
            If .RecordCount > 0 And .EOF Then
                .MoveLast
                ElseIf .RecordCount = 0 Then .MovePrevious
            End If
      End With
    End If

  Exit Sub
DeleteErr:
  MsgBox Err.Description

End Sub

Private Sub cmdFilter_Click()
    Dim strFilter As String
    Dim strFilter2 As String
    '生成filter字符串
    strFilter = ""
    If Trim(txtFields(14).Text) <> "" Then
        strFilter = "总号=" & Trim(txtFields(14).Text)
    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 DataCombo3.Text <> "" Then
        If strFilter = "" Then
            strFilter = "分类ID=" & DataCombo3.BoundText
            strFilter2 = "分类='" & DataCombo3.Text & "'"
        Else
            strFilter = strFilter & " and 分类ID=" & DataCombo3.BoundText
            strFilter2 = strFilter & " and 分类='" & DataCombo3.Text & "'"
        End If
    End If
    datPrimaryRS.Recordset.Filter = ""               'adFilterNone
    datPrimaryRS.Recordset.Filter = strFilter
    Adodc2.Recordset.Filter = ""               'adFilterNone
    Adodc2.Recordset.Filter = strFilter2
    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 = Adodc2.Recordset.RecordCount
    If Num = 0 Then
      MsgBox "发排数据为空。", vbInformation
      Exit Sub
    End If
    ReDim DataArray(1 To Num, 1 To 13) As Variant
    
    Adodc2.Recordset.MoveFirst
    For i = 1 To Num
        For j = 1 To 13
            DataArray(i, j) = Adodc2.Recordset.Fields(j - 1).Value
        Next
        Adodc2.Recordset.MoveNext
    Next
    Adodc2.Recordset.MoveFirst
    
    'Add headers to the worksheet on row 1
    Set oSheet = oBook.Worksheets(1)
    oSheet.Range("A1:M1").Select
    With oExcel.Selection
        .HorizontalAlignment = -4108
        .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    oSheet.Range("A1").Value = "技术资料登记帐"
    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("K2").Value = "页数"
    oSheet.Range("L2").Value = "单价"
    oSheet.Range("M2").Value = "备注"
    oSheet.Range("A2:M2").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, 13).Value = DataArray
    
    oSheet.Range("A2:M" & 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
    oSheet.Columns("K:K").EntireColumn.AutoFit
    oSheet.Columns("L:L").EntireColumn.AutoFit
    oSheet.Columns("M:M").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 = 12
        .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 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.UpdateBatch adAffectAll
  Exit Sub
UpdateErr:
  MsgBox Err.Description

End Sub

Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  datPrimaryRS.Caption = CStr(datPrimaryRS.Recordset.AbsolutePosition)
  lbl记录数.Caption = CStr(datPrimaryRS.Recordset.RecordCount)

End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
  Select Case SSTab1.Tab
  Case 0
      If Not (Adodc2.Recordset.EOF Or Adodc2.Recordset.BOF) Then
          datPrimaryRS.Recordset.MoveFirst
          datPrimaryRS.Recordset.Find "总号 = " & Adodc2.Recordset.Fields("总号").Value, , adSearchForward, 0
      End If
  Case 1
      If PreviousTab = 0 Then
        Adodc2.Refresh
        If Not (datPrimaryRS.Recordset.EOF Or datPrimaryRS.Recordset.BOF) Then
            Adodc2.Recordset.MoveFirst
            Adodc2.Recordset.Find "总号 = " & datPrimaryRS.Recordset.Fields("总号").Value, , adSearchForward, 0
        End If
      End If
  End Select
End Sub


Private Sub UserDocument_Initialize()
    With datPrimaryRS
        .ConnectionString = pConn
        .RecordSource = "select 总号,登记日期,分类id,文别,密别,资料名称,编制单位,编制日期,来源,份数,页数,单价,备注 from 技术资料 Order by 总号"
        .Refresh
    End With

    With Adodc1
        .ConnectionString = pConn
        .RecordSource = "图书分类"
        .Refresh
    End With

    With Adodc2
        .ConnectionString = pConn
        
        .RecordSource = "SELECT 技术资料.登记日期, 技术资料.总号, 图书分类.分类, 技术资料.文别, " & _
      "技术资料.密别, 技术资料.资料名称, 技术资料.编制单位, " & _
      "技术资料.编制日期, 技术资料.来源, 技术资料.份数, 技术资料.页数, " & _
      "技术资料.单价, 技术资料.备注 " & _
      "FROM 技术资料 LEFT OUTER JOIN " & _
      "图书分类 ON 技术资料.分类id = 图书分类.分类ID"
        
        .Refresh
    End With



End Sub

Private Sub UserDocument_Show()
    datPrimaryRS.Refresh
End Sub