?? form_main.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -