7,762
社区成员
发帖
与我相关
我的任务
分享关于 ExecuteStatement 的问题，第三次贴
Public Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function
我调用的是 ExecuteLine "Form1.Show" 在调试的时候顺利通过，可是编译之后一运行却是跳也来了，没有任何提示，这是为什么呀，望各位援手，十万火急
我也试过用 ScriptControl
Set AA = CreateObject("MSScriptControl.ScriptControl")
AA.ExecuteStatement ("FORM1.Show")
结果提示“要求对象 Form1 ”
ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function
我调用的是 ExecuteLine "Form1.Show" 在调试的时候顺利通过，可是编译之后一运行却是跳也来了，没有任何提示，这是为什么呀，望各位援手，十万火急
我也试过用 ScriptControl
Set AA = CreateObject("MSScriptControl.ScriptControl")
AA.ExecuteStatement ("FORM1.Show")
结果提示“要求对象 Form1 ”
...全文
请发表友善的回复…
发表回复
行云边 2004-10-22
- 打赏
- 举报
同意 northwolves(狼行天下)
其实有些问题可以换个方法来实现的 不知道楼主碰到什么问题一定要ExecuteLine 能不能细说
其实有些问题可以换个方法来实现的 不知道楼主碰到什么问题一定要ExecuteLine 能不能细说
northwolves 2004-10-22
- 打赏
- 举报
贴出你的代码让大家看看
adong1980 2004-10-22
- 打赏
- 举报
"Form1" 只是一个字符串，还有ＤｏｃＴｙｐｅ也只能是一个字条串
adong1980 2004-10-22
- 打赏
- 举报
为什么我用 scr.executestatement "form1.show" 执行之后我的用CreateMenu出来的菜单却是没有掉了
行云边 2004-10-22
- 打赏
- 举报
你为什么在设计的时候不自己建立一个form 呢 譬如：
dim m_forms() as Form1 'from1 指针数组
dim m_formCount as integer 'from1的个数
然后要加载的时候
m_formCount=m_formCount+1
ReDim Preserve m_forms(m_formCount)
set m_forms(m_formCount)=new Form1
m_forms(m_formCount).show
m_forms(m_formCount).DocType="01"
dim m_forms() as Form1 'from1 指针数组
dim m_formCount as integer 'from1的个数
然后要加载的时候
m_formCount=m_formCount+1
ReDim Preserve m_forms(m_formCount)
set m_forms(m_formCount)=new Form1
m_forms(m_formCount).show
m_forms(m_formCount).DocType="01"
adong1980 2004-10-22
- 打赏
- 举报
其实很简单我的菜单的对应的窗体都在数据库里面，然后点中相应菜单就有相应的窗体，好吧，我现在先把代码贴出来，有些地方不简化了，能说明意思就行了，现在假设一个工程，有一个MDIForm ，一个Bas_info（窗体），还有一个模块，我要的很简单，菜单是在MDIForm Load 的时候创建的
'1 MDIForm 里的代码
Private Sub MDIForm_Activate() '本来的打算放在Load事件里面发现Load的时候不能装载，
'这是为什么
LoadMenu 0, Me.hwnd
End Sub
Private Sub MDIForm_Load()
On Error Resume Next
'装备截取窗体的事件，获取点中菜单，这里也有一个问题,等一下说到
prvWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取，而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, prvWinProc)
End Sub
'2 模块里对应的代码
Option Explicit
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long
Public Const WM_COMMAND = &H111
Public Const MF_BYCOMMAND = &H0&
Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const MF_BYPOSITION = &H400&
Public Const WM_MENUSELECT = &H11F
Public Const GWL_WNDPROC = (-4)
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_INITMENU = &H116
Public prvWinProc As Long
Public ret As Long
Public AA As Object ' MSScriptControl
Public TmpHeadMenuHwnd As Long ' 置顶菜单
Public Function LOWORD(dwValue As Long) As Long
CopyMemory LOWORD, dwValue, 2
End Function
Public Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(ByVal StrPtr(sCode), 0&, 0&, ABS(fCheckOnly)) = 0
End Function
Public Sub LoadMenu(PrjID As Integer, MDIHwnd As Long)
Dim RstLoadMenu As ADODB.Recordset
Dim RstLoadedMenu As ADODB.Recordset
Dim TmpSubMenuHwnd As Long
'这里本来是数据库里读出来的，现在简单一点写
'AppendMenu 里面的那一个1,“常用资料”是应该是从数据库里读出
'数据库里知道1对应的就是常用资料
TmpHeadMenuHwnd = CreateMenu
TmpSubMenuHwnd = CreateMenu
AppendMenu TmpSubMenuHwnd, MF_STRING + MF_POPUP, 1, "常用资料"
InsertMenu TmpHeadMenuHwnd, 1, MF_STRING + MF_POPUP, TmpSubMenuHwnd, "基础资料"
SetMenu MDIHwnd, TmpHeadMenuHwnd
Exit Sub
End Sub
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim LngSelectMenuHwnd As Long
If Msg = WM_COMMAND Then '点击菜单里，但是我现在也发现有个问题
'就是如果点中的Command的时候也会有Msg=WM_Command ，当然我说的不是在MDIForm上，
'而是在一个普通的窗体上,如果也有按键的话
If lParam = 0 Then '是我用来区别点中的是菜单还是不是菜单用的，
'我只是调试的时候看到，不知道正确的应该是怎么样
LngSelectMenuHwnd = LOWORD(wParam) ’得到点中的那一个菜单
If LngSelectMenuHwnd = 1 Then '应该和数据库里的对应，现在就假设是1了
'**********************************************************************
'这段是刚刚写的程序来是就是两句 ’ExecuteLine ("Bas_info.DOCType=""02""")
'ExecuteLine ("Bas_info.Show") 的 ，后来发现在调试的时候正常，编译一运行就跳出来了，
'于是就改成这个样了.可是现在这样一执行我的MDI上的菜单就没有， 这是为什么呀
'
'
Dim f As Form
Set f = Forms.Add("bas_info")
Set AA = CreateObject("MSScriptControl.ScriptControl")
AA.Language = "vbscript"
AA.AddObject "Bas_Info", f
AA.ExecuteStatement ("Bas_info.DOCType=""02""")
AA.ExecuteStatement ("bas_info.Show")
'**********************************************************************
End If
End If
End If
WndProc = CallWindowProc(prvWinProc, hwnd, Msg, wParam, lParam)
Exit Function
END Function
'3Bas_Info 里面加入
Option Explicit
Public Property Get DocType() As String
End Property
Public Property Let DocType(ByVal vNewValue As String)
If vNewValue = "01" Then
Me.Caption = "第一种"
Else
Me.Caption = "第二种"
End If
End Property
我的Email是Adong1980@21cn.com QQ:38054489 有什么建议可以直接找，欢迎多指教
'1 MDIForm 里的代码
Private Sub MDIForm_Activate() '本来的打算放在Load事件里面发现Load的时候不能装载，
'这是为什么
LoadMenu 0, Me.hwnd
End Sub
Private Sub MDIForm_Load()
On Error Resume Next
'装备截取窗体的事件，获取点中菜单，这里也有一个问题,等一下说到
prvWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取，而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, prvWinProc)
End Sub
'2 模块里对应的代码
Option Explicit
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal nCount As Long)
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long
Public Const WM_COMMAND = &H111
Public Const MF_BYCOMMAND = &H0&
Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const MF_BYPOSITION = &H400&
Public Const WM_MENUSELECT = &H11F
Public Const GWL_WNDPROC = (-4)
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_INITMENU = &H116
Public prvWinProc As Long
Public ret As Long
Public AA As Object ' MSScriptControl
Public TmpHeadMenuHwnd As Long ' 置顶菜单
Public Function LOWORD(dwValue As Long) As Long
CopyMemory LOWORD, dwValue, 2
End Function
Public Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
ExecuteLine = EbExecuteLine(ByVal StrPtr(sCode), 0&, 0&, ABS(fCheckOnly)) = 0
End Function
Public Sub LoadMenu(PrjID As Integer, MDIHwnd As Long)
Dim RstLoadMenu As ADODB.Recordset
Dim RstLoadedMenu As ADODB.Recordset
Dim TmpSubMenuHwnd As Long
'这里本来是数据库里读出来的，现在简单一点写
'AppendMenu 里面的那一个1,“常用资料”是应该是从数据库里读出
'数据库里知道1对应的就是常用资料
TmpHeadMenuHwnd = CreateMenu
TmpSubMenuHwnd = CreateMenu
AppendMenu TmpSubMenuHwnd, MF_STRING + MF_POPUP, 1, "常用资料"
InsertMenu TmpHeadMenuHwnd, 1, MF_STRING + MF_POPUP, TmpSubMenuHwnd, "基础资料"
SetMenu MDIHwnd, TmpHeadMenuHwnd
Exit Sub
End Sub
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim LngSelectMenuHwnd As Long
If Msg = WM_COMMAND Then '点击菜单里，但是我现在也发现有个问题
'就是如果点中的Command的时候也会有Msg=WM_Command ，当然我说的不是在MDIForm上，
'而是在一个普通的窗体上,如果也有按键的话
If lParam = 0 Then '是我用来区别点中的是菜单还是不是菜单用的，
'我只是调试的时候看到，不知道正确的应该是怎么样
LngSelectMenuHwnd = LOWORD(wParam) ’得到点中的那一个菜单
If LngSelectMenuHwnd = 1 Then '应该和数据库里的对应，现在就假设是1了
'**********************************************************************
'这段是刚刚写的程序来是就是两句 ’ExecuteLine ("Bas_info.DOCType=""02""")
'ExecuteLine ("Bas_info.Show") 的 ，后来发现在调试的时候正常，编译一运行就跳出来了，
'于是就改成这个样了.可是现在这样一执行我的MDI上的菜单就没有， 这是为什么呀
'
'
Dim f As Form
Set f = Forms.Add("bas_info")
Set AA = CreateObject("MSScriptControl.ScriptControl")
AA.Language = "vbscript"
AA.AddObject "Bas_Info", f
AA.ExecuteStatement ("Bas_info.DOCType=""02""")
AA.ExecuteStatement ("bas_info.Show")
'**********************************************************************
End If
End If
End If
WndProc = CallWindowProc(prvWinProc, hwnd, Msg, wParam, lParam)
Exit Function
END Function
'3Bas_Info 里面加入
Option Explicit
Public Property Get DocType() As String
End Property
Public Property Let DocType(ByVal vNewValue As String)
If vNewValue = "01" Then
Me.Caption = "第一种"
Else
Me.Caption = "第二种"
End If
End Property
我的Email是Adong1980@21cn.com QQ:38054489 有什么建议可以直接找，欢迎多指教
jam021 2004-10-22
- 打赏
- 举报
关注,帮你顶!
northwolves 2004-10-21
- 打赏
- 举报
ExecuteLine "Form1.Show" 编译后一般都出错，原因是VBA6.DLL只能运行于VB IDE 环境
northwolves 2004-10-21
- 打赏
- 举报
你必须告诉MSScriptControl 有关FORM1的信息：
Option Explicit
Sub Main()
Dim scr As Object
Set scr = CreateObject("MSScriptControl.ScriptControl")
scr.Language = "vbscript"
scr.Addobject "form1", Form1
scr.executestatement "form1.show"
Set scr = Nothing
End Sub
Option Explicit
Sub Main()
Dim scr As Object
Set scr = CreateObject("MSScriptControl.ScriptControl")
scr.Language = "vbscript"
scr.Addobject "form1", Form1
scr.executestatement "form1.show"
Set scr = Nothing
End Sub
adong1980 2004-10-21
- 打赏
- 举报
Form1 都已经Show了，那执行AA.ExecuteStatement ("FORM1.Show") 也没有什么意思了呀，我在要Show之后有些属性要传入的
leolan 2004-10-21
- 打赏
- 举报
我想可能是在執行 AA.ExecuteStatement ("FORM1.Show") 之前Form1沒有被加載吧.
試試這樣:
Dim f As Form
Set f = Forms.Add("FORM1")
f.Show
試試這樣:
Dim f As Form
Set f = Forms.Add("FORM1")
f.Show
