?? frmpopmenu.frm
字號:
VERSION 5.00
Begin VB.Form frmPopmenu
Caption = "彈出式菜單"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.Menu Popmenu
Caption = "popmenu"
Visible = 0 'False
Begin VB.Menu Popmenu_AddClient
Caption = "添加客戶信息"
End
Begin VB.Menu Popmenu_ChangeClient
Caption = "修改客戶信息"
End
Begin VB.Menu Popmenu_CheckClient
Caption = "查詢客戶信息"
End
Begin VB.Menu Popmenu_SendMail
Caption = "發送電子郵件"
End
End
Begin VB.Menu popmenu2
Caption = "popmenu2"
Visible = 0 'False
Begin VB.Menu Popmenu_ChangeCompany
Caption = "修改企業信息"
End
Begin VB.Menu Popmenu_CheckCompany
Caption = "查詢企業信息"
End
Begin VB.Menu Popmenu_DelCompany
Caption = "刪除企業信息"
End
End
End
Attribute VB_Name = "frmPopmenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'聲明函數發送電子郵件
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As _
Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Popmenu_AddClient_Click() '添加客戶
ichangeFlag = 1
frmAddPer.Show
frmAddPer.ZOrder 0
End Sub
Private Sub Popmenu_ChangeClient_Click() '修改客戶信息
ichangeFlag = 2
If frmPerResult.MSFlexGrid1.Rows > 1 Then
strPublicSQL = "select * from Personal where ID="
strPublicSQL = strPublicSQL & Trim(frmPerResult.MSFlexGrid1.TextMatrix( _
frmPerResult.MSFlexGrid1.Row, 0))
frmAddPer.Caption = "修改客戶信息"
frmAddPer.cmdOK.Caption = "修 改"
frmAddPer.Show
frmAddPer.ZOrder 0
Else
MsgBox "目前沒有客戶信息", vbOKOnly + vbExclamation, "警告!"
If MsgBox("是否添加客戶信息?", vbOKCancel) = vbOK Then
ichangeFlag = 1
frmAddPer.Show
frmAddPer.ZOrder 0
End If
End If
End Sub
Private Sub Popmenu_ChangeCompany_Click() '修改公司信息
If frmComResult.MSFlexGrid1.Rows > 1 Then
strPublicSQL = "select * from Company where ID="
strPublicSQL = strPublicSQL & Trim(frmComResult.MSFlexGrid1.TextMatrix( _
frmComResult.MSFlexGrid1.Row, 0))
frmCompany.Show
frmCompany.ZOrder 0
Else
Exit Sub
End If
End Sub
Private Sub Popmenu_CheckClient_Click() '查詢客戶
frmCheckPerson.Show
frmCheckPerson.ZOrder 0
End Sub
Private Sub Popmenu_CheckCompany_Click() '查詢公司
frmCheckCompany.Show
frmCheckCompany.ZOrder 0
End Sub
Private Sub Popmenu_DelCompany_Click() '刪除公司信息
Dim sql As String
Dim rs As New ADODB.Recordset
sql = "select * from Personal where Company ='" & Trim(frmComResult.MSFlexGrid1.TextMatrix( _
frmComResult.MSFlexGrid1.Row, 1)) & "'"
Set rs = getRS(sql)
If rs.EOF = False Then
MsgBox "目前這個公司還是客戶不能刪除!", vbOKOnly + vbExclamation, "提示!"
Call frmPerResult.showTopic
Call frmPerResult.showData(sql)
frmPerResult.Show
frmPerResult.ZOrder 0
Exit Sub
Else
sql = "delete from Company where ID=" & Trim(frmComResult.MSFlexGrid1.TextMatrix( _
frmComResult.MSFlexGrid1.Row, 0))
If MsgBox("真的要刪除這條記錄么?", vbOKCancel + vbExclamation, "提示!") = vbOK _
Then
Call TransactSQL(sql)
MsgBox "記錄已經刪除!", vbOKOnly + vbExclamation, "提示!"
sql = "select * from Company order by ID"
Call frmComResult.showComTopic
Call frmComResult.showComData(sql)
End If
End If
rs.Close
End Sub
Private Sub Popmenu_SendMail_Click() '發送電子郵件
Dim strAim As String
Dim perjump As Integer
Dim emailAddress As String
strAim = Trim(frmPerResult.MSFlexGrid1.TextMatrix(frmPerResult.MSFlexGrid1.Row, 13))
If strAim <> "" Then
emailAddress = "mailto:" & strAim '獲得電子郵件地址
perjump = ShellExecute(0&, vbNullString, emailAddress, vbNullString, vbNullString, _
vbNormalFocus)
Else
MsgBox "沒有Email地址", vbOKOnly + vbExclamation, "提示"
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -