f_guidangbumen.frm

行政管理系统商业源码,可以down下来看看

            Begin VB.CommandButton cmdDelete 
               Caption         =   "删除"
               Height          =   300
               Left            =   2400
               TabIndex        =   9
               Top             =   0
               Width           =   1095
            End
            Begin VB.CommandButton cmdRefresh 
               Caption         =   "刷新"
               Height          =   300
               Left            =   3600
               TabIndex        =   8
               Top             =   0
               Width           =   1095
            End
            Begin VB.CommandButton cmdClose 
               Caption         =   "关闭"
               Height          =   300
               Left            =   4800
               TabIndex        =   7
               Top             =   0
               Width           =   1095
            End
            Begin VB.CommandButton cmdUpdate 
               Caption         =   "保存"
               BeginProperty Font 
                  Name            =   "MS Sans Serif"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   300
               Left            =   3600
               TabIndex        =   6
               Top             =   0
               Visible         =   0   'False
               Width           =   1095
            End
            Begin VB.CommandButton cmdCancel 
               Caption         =   "取消"
               BeginProperty Font 
                  Name            =   "MS Sans Serif"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   300
               Left            =   4800
               TabIndex        =   5
               Top             =   0
               Visible         =   0   'False
               Width           =   1095
            End
         End
         Begin VB.Frame Frame3 
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   5775
            Left            =   -74760
            TabIndex        =   2
            Top             =   480
            Width           =   9375
            Begin MSDataGridLib.DataGrid DataGrid1 
               Height          =   5175
               Left            =   240
               TabIndex        =   3
               Top             =   360
               Width           =   8895
               _ExtentX        =   15690
               _ExtentY        =   9128
               _Version        =   393216
               AllowUpdate     =   0   'False
               HeadLines       =   1
               RowHeight       =   14
               BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
                  Name            =   "MS Sans Serif"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
                  Name            =   "宋体"
                  Size            =   9
                  Charset         =   134
                  Weight          =   400
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               ColumnCount     =   2
               BeginProperty Column00 
                  DataField       =   ""
                  Caption         =   ""
                  BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                     Type            =   0
                     Format          =   ""
                     HaveTrueFalseNull=   0
                     FirstDayOfWeek  =   0
                     FirstWeekOfYear =   0
                     LCID            =   2052
                     SubFormatType   =   0
                  EndProperty
               EndProperty
               BeginProperty Column01 
                  DataField       =   ""
                  Caption         =   ""
                  BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
                     Type            =   0
                     Format          =   ""
                     HaveTrueFalseNull=   0
                     FirstDayOfWeek  =   0
                     FirstWeekOfYear =   0
                     LCID            =   2052
                     SubFormatType   =   0
                  EndProperty
               EndProperty
               SplitCount      =   1
               BeginProperty Split0 
                  BeginProperty Column00 
                  EndProperty
                  BeginProperty Column01 
                  EndProperty
               EndProperty
            End
         End
      End
   End
End
Attribute VB_Name = "F_GuiDangBuMen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1

Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean


Private Sub Form_Load()
  
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select 部门,原文编号,类型,原文日期,文件名称,文件载体,备注,类型归档代码,归档编号,归档日期,部门归档保存位置,转档日期 ,是否转档 from 部门文件归档  Where  是否转档 <> '是'", db, adOpenStatic, adLockOptimistic

  Set DataGrid1.DataSource = adoPrimaryRS
  
  SetButtons True

  
  Dim oText As TextBox
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next
  
  Set DTPicker1.DataSource = adoPrimaryRS
  Set DTPicker2.DataSource = adoPrimaryRS
  Set Combo1.DataSource = adoPrimaryRS

   SqlBuMen = "select  distinct 部门名称 from 部门维护表"
  Set RsBuMen = db.Execute(SqlBuMen)
   
  While Not RsBuMen.EOF
     Combo1.AddItem Trim(RsBuMen("部门名称"))
    RsBuMen.MoveNext

  Wend
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr

  
  
 With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
  adoPrimaryRS.Fields("是否转档") = "否"
    mbAddNewFlag = True
    SetButtons False
  End With
  

  Exit Sub
AddErr:
  MsgBox "增加操作有错误", vbExclamation + vbOKOnly, pTitle
  
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox "删除操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdRefresh_Click()
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
   MsgBox "刷新操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
   MsgBox "更改操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub
Private Sub cmdCancel_Click()
 ' On Error Resume Next
 On Error GoTo CancelErr


  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate

  If mvBookMark > 0 Then
   adoPrimaryRS.Bookmark = mvBookMark
  Else
   adoPrimaryRS.MoveFirst
  End If
 SetButtons True
  Exit Sub
CancelErr:
   
   MsgBox "取消操作有错误", vbExclamation + vbOKOnly, pTitle

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  adoPrimaryRS.UpdateBatch adAffectAll

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True


  Exit Sub
UpdateErr:
   MsgBox "保存操作有错误", vbExclamation + vbOKOnly, pTitle
End Sub

Private Sub cmdClose_Click()
  WenJianGL.Enabled = True
  Unload Me
End Sub

Private Sub SetButtons(bVal As Boolean)
Dim oText As TextBox
  
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  If bVal Then
   Set DataGrid1.DataSource = adoPrimaryRS
  Else
   Set DataGrid1.DataSource = Nothing
  End If
  
 For Each oText In Me.txtFields
     oText.Enabled = Not bVal
  Next
  
   DTPicker1.Enabled = Not bVal
   DTPicker2.Enabled = Not bVal
   Combo1.Enabled = Not bVal

End Sub


















Private Sub txtFields_LostFocus(Index As Integer)
If Index = 8 Then

  SqlBianHao = "select   *   from 部门文件归档 where 归档编号  = '" & txtFields(8).Text & "'"
  Set RsBianHao = db.Execute(SqlBianHao)
   
  If Not RsBianHao.EOF Then
  
    MsgBox "此归档编号已重复，请输入新的归档编号", vbExclamation + vbOKOnly, pTitle
   
  End If
     

End If
End Sub