📄 form_main.frm

📁 新世纪ERP系统管理源代码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      Begin VB.Menu Start 
         Caption         =   "启用"
      End
      Begin VB.Menu NEWKJQJ 
         Caption         =   "创建下年度会计期间"
      End
      Begin VB.Menu sds 
         Caption         =   "-"
      End
      Begin VB.Menu User 
         Caption         =   "用户"
         Shortcut        =   ^U
      End
      Begin VB.Menu log 
         Caption         =   "上机日志"
      End
   End
   Begin VB.Menu SZ 
      Caption         =   "设置"
      Begin VB.Menu DJSZ 
         Caption         =   "单据设计"
         Begin VB.Menu DJRLSJ 
            Caption         =   "单据录入设计"
         End
         Begin VB.Menu DJDYSJ 
            Caption         =   "单据打印设计"
         End
      End
   End
   Begin VB.Menu BZ 
      Caption         =   "帮助(&H)"
      Begin VB.Menu Help 
         Caption         =   "帮助主题"
      End
      Begin VB.Menu dfg 
         Caption         =   "-"
      End
      Begin VB.Menu about 
         Caption         =   "关于"
         Shortcut        =   ^A
      End
   End
End
Attribute VB_Name = "Form_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mitem As ListItem

Private Sub about_Click()
    XT_frmAbout.Show 1
End Sub

Private Sub Bak_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_Bakdatabase.Text1.Tag = List_data.SelectedItem.SubItems(2)
    Frm_Bakdatabase.Text2.Text = List_data.SelectedItem.SubItems(2)
    Frm_Bakdatabase.Caption = "套帐备份---" & List_data.SelectedItem.SubItems(1)
    Frm_Bakdatabase.Show 1
End Sub


Private Sub cjuser_Click()
    On Error Resume Next
    Conn_System.Execute "EXEC sp_addlogin 'HXXD', '123'"
    Conn_System.Execute "EXEC sp_addsrvrolemember 'HXXD', 'sysadmin'"
    If Trim(Err.Description) = "" Then
       MsgBox "创建成功！  ", 48
       Else
       MsgBox Err.Description, 16
    End If
End Sub

Private Sub Del_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    YesNoStr = MsgBox("你是否要删除编号为(" & List_data.SelectedItem.Text & ")的套帐！  ", vbYesNo + 32)
    If YesNoStr = vbNo Then Exit Sub
    Dele_CountingRoom List_data.SelectedItem.Key
End Sub

Private Sub DJDYSJ_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    If Cw_DataEnvi.DataConnect.State = 1 Then Cw_DataEnvi.DataConnect.Close
    Cw_DataEnvi.DataConnect.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & ServerName_Str & "; Initial Catalog=" & List_data.SelectedItem.SubItems(2) & ";", "HXXD", "123"
    XT_BillPrintDesign.Tag = List_data.SelectedItem.SubItems(1) & "/" & XT_BillPrintDesign.Caption
    XT_BillPrintDesign.Caption = List_data.SelectedItem.SubItems(1) & "/" & XT_BillPrintDesign.Caption
    XT_BillPrintDesign.Show 1
End Sub

Private Sub DJRLSJ_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    If Cw_DataEnvi.DataConnect.State = 1 Then Cw_DataEnvi.DataConnect.Close
    Cw_DataEnvi.DataConnect.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & ServerName_Str & "; Initial Catalog=" & List_data.SelectedItem.SubItems(2) & ";", "HXXD", "123"
    XT_BillDesign.Tag = List_data.SelectedItem.SubItems(1) & "/" & XT_BillDesign.Caption
    XT_BillDesign.Caption = List_data.SelectedItem.SubItems(1) & "/" & XT_BillDesign.Caption
    XT_BillDesign.Show 1
End Sub

Private Sub Edit_Click()
    Frm_Password.Show 1
End Sub

Private Sub Exit_Click()
    Unload Me
End Sub

Public Sub Form_Load()
    On Error Resume Next
    Dim aDo_DataBase As New Recordset
    Set aDo_DataBase = Conn_System.Execute("select * from HDSystem_DataBases")
     List_data.ListItems.Clear
    With aDo_DataBase
    Do While Not .EOF
        Set mitem = List_data.ListItems.Add()
        mitem.Text = !Number
        mitem.SmallIcon = "l"
        mitem.Icon = "l"
        mitem.SubItems(1) = !CountingRoomName
        mitem.SubItems(2) = !DataBasesName
        mitem.SubItems(3) = !NewDate
        mitem.SubItems(4) = "" & !BackupDate
        mitem.SubItems(5) = Trim("" & !ServerName)
        mitem.SubItems(6) = Trim("" & !DatabaseType)
        mitem.Key = !DataBasesName
       
        .MoveNext
    Loop
    .Close
    Set aDo_DataBase = Nothing
    End With
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    List_data.Width = Me.Width - 100
    List_data.Height = Me.Height - Tool.Height - StatusBar.Height - 680
End Sub


Private Sub Help_Click()
    SendKeys "{F1}", True
End Sub

Private Sub HigherUpCo_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_HigherUpCo.Tag = List_data.SelectedItem.SubItems(2)
    Frm_HigherUpCo.Caption = Frm_HigherUpCo.Caption & "---" & List_data.SelectedItem.SubItems(1)
    
    Frm_HigherUpCo.Show 1
End Sub



Private Sub log_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_Log.Tag = List_data.SelectedItem.SubItems(2)
    Frm_Log.Caption = Frm_Log.Caption & "---" & List_data.SelectedItem.SubItems(1)
    Frm_Log.Show 1
End Sub

Private Sub NewDatabase_Click()
    Frm_Newdatabase.Show 1
End Sub

Private Sub NEWKJQJ_Click()
   If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
      Form_NewKJQJ.Text1(0).Tag = List_data.SelectedItem.SubItems(2)
      Form_NewKJQJ.Caption = Form_NewKJQJ.Caption & "---" & List_data.SelectedItem.SubItems(1)
      Form_NewKJQJ.Show 1
End Sub

Private Sub P_Click()
     If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    With Frm_Newdatabase
     .Text1(0).Enabled = False: .Text1(1).Enabled = False: .Text1(2).Enabled = False: .Text1(3).Enabled = False
     .Text2(0).Enabled = False: .Text2(1).Enabled = False: .Text2(2).Enabled = False
     .Text1(0).Text = List_data.SelectedItem.Text
     .Text1(1).Text = List_data.SelectedItem.SubItems(1)
     .Text1(2).Text = List_data.SelectedItem.SubItems(2)
     .Command1(0).Enabled = False
     .Command2.Enabled = False
     .Text1(3).Text = ""
     .Show 1
    End With
End Sub

Private Sub Refresh_Click()
    Form_Load
End Sub

Private Sub Restore_Click()
    Frm_RestoerDatabase.Show 1
End Sub

Private Sub Setup_Click()
   If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
  Frm_DateCoInfo.Text1(0).Tag = List_data.SelectedItem.SubItems(2)
  Frm_DateCoInfo.Caption = Frm_DateCoInfo.Caption & "---" & List_data.SelectedItem.SubItems(1)
  Frm_DateCoInfo.Show 1
End Sub

Private Sub Start_Click()
On Error Resume Next
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Dim Ssql  As String
    Dim aDo_Rows As New Recordset
    
    YesNoStr = MsgBox("你是否要启用此套帐?  ", vbYesNo + 32)
    If YesNoStr = vbNo Then Exit Sub
    Ssql = "select * from HDSystem_DataBases where DataBasesName='" & List_data.SelectedItem.SubItems(2) & "'"
    Set aDo_Rows = Conn_System.Execute(Ssql)
    If Trim("" & aDo_Rows!YNUse) = "1" Then MsgBox "套帐已经在使用! ", 16: aDo_Rows.Close: Set aDo_Rows = Nothing: Exit Sub
    If Trim("" & aDo_Rows!CoName) = "" Then MsgBox "套帐设置公司名称错误,套帐不能被启用! ", 16: aDo_Rows.Close: Set aDo_Rows = Nothing: Exit Sub
    aDo_Rows.Close
    
    Ssql = "select * from " & List_data.SelectedItem.SubItems(2) & ".dbo.Gy_kjrlb"
    Set aDo_Rows = Conn_System.Execute(Ssql)
    If aDo_Rows.RecordCount <> 12 Then
        MsgBox "套帐设置错误,套帐不能被启用! ", 16: aDo_Rows.Close: Set aDo_Rows = Nothing: Exit Sub
    End If
    aDo_Rows.Close: Set aDo_Rows = Nothing
    
    Ssql = "update HDSystem_DataBases set YNuse='1' where DataBasesName='" & List_data.SelectedItem.SubItems(2) & "'"
    Conn_System.Execute Ssql
    MsgBox "套帐启用成功! ", 48

End Sub

Private Sub Tool_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "New"
       
            Frm_Newdatabase.Show 1
            
       Case "Property"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
           With Frm_Newdatabase
            .Text1(0).Enabled = False: .Text1(1).Enabled = False: .Text1(2).Enabled = False: .Text1(3).Enabled = False
            .Text2(0).Enabled = False: .Text2(1).Enabled = False: .Text2(2).Enabled = False
            .Text1(0).Text = List_data.SelectedItem.Text
            .Text1(1).Text = List_data.SelectedItem.SubItems(1)
            .Text1(2).Text = List_data.SelectedItem.SubItems(2)
            .Command1(0).Enabled = False
            .Command2.Enabled = False
            .Text1(3).Text = ""
            .Show 1
           End With
       Case "Bak"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
            Frm_Bakdatabase.Text1.Tag = List_data.SelectedItem.SubItems(2)
            Frm_Bakdatabase.Text2.Text = List_data.SelectedItem.SubItems(2)
            Frm_Bakdatabase.Caption = "套帐备份---" & List_data.SelectedItem.SubItems(1)
            Frm_Bakdatabase.Show 1
       Case "Del"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
            YesNoStr = MsgBox("你是否要删除编号为(" & List_data.SelectedItem.Text & ")的套帐！  ", vbYesNo + 32)
            If YesNoStr = vbNo Then Exit Sub
            Dele_CountingRoom List_data.SelectedItem.Key
       Case "Restore"
             Frm_RestoerDatabase.Show 1
       Case "Setup"
               If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
             Frm_DateCoInfo.Text1(0).Tag = List_data.SelectedItem.SubItems(2)
             Frm_DateCoInfo.Caption = Frm_DateCoInfo.Caption & "---" & List_data.SelectedItem.SubItems(1)
             
             Frm_DateCoInfo.Show 1
       Case "User"
              If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
             Frm_GroupUser.Caption = Frm_GroupUser.Caption & "---" & List_data.SelectedItem.SubItems(1)
             Frm_GroupUser.ListView1.Tag = List_data.SelectedItem.SubItems(2)
             Frm_GroupUser.Show 1
       Case "Start"
             Start_Click
       Case "Exit"
            Unload Me
End Select
End Sub
Private Sub Dele_CountingRoom(DataBaseName As String)
    On Error GoTo Exit_err
        Class.StatusBar "正在删除套帐信息...", False
        Me.MousePointer = 12
        Conn_System.Execute "Drop Database " & DataBaseName
        Conn_System.Execute "delete HDSystem_DataBases where DataBasesName='" & DataBaseName & "'"
        Form_Load
        Class.StatusBar "", True
        Me.MousePointer = 0
        Exit Sub
    
Exit_err:
    Form_Load
    Class.StatusBar "", True
    Me.MousePointer = 0
    MsgBox Err.Description & "(" & Err.Number & ")", 16
End Sub

Private Sub User_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_GroupUser.Caption = Frm_GroupUser.Caption & "---" & List_data.SelectedItem.SubItems(1)
    Frm_GroupUser.ListView1.Tag = List_data.SelectedItem.SubItems(2)
    Frm_GroupUser.Show 1
End Sub

Private Sub XD_Click()
    frmBrowser.Show
End Sub
上一页 12
💿 文件大小 212 K
👤 上传用户 hjf
📂 所属分类企业管理
🏷️ 相关标签

#ERP #系统管理 #源代码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -