如何将Excel嵌入到VB中
2个回答
展开全部
将Excel数据嵌入到VB中,使他在VB的MDI窗体中,看起来就像VB的一部分,同时我也可以用代码对其进行读写
我用OLE把它嵌入到里面,不过每次双击以后,出来的Excel大小我无法控制
(我不想用对象的方式来操作Excel,因为我要把编辑表格的界面提供给用户)
bas中:
Public XL As Excel.Application, xlHwnd As Long
Public
Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long)
Public
Const WS_CAPTION As Long = &HC00000
Public Const SW_SHOW As Long = 5
Public Const WS_EX_APPWINDOW = &H40000
Public Const SW_SHOWMAXIMIZED
= 3
Public Const GWL_STYLE As Long = -16
Public Const GW_HWNDNEXT =
2
Public Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal
hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function
GetParent Lib "user32 " (ByVal hwnd As Long) As Long
Public Declare Function
FindWindow Lib "user32 " Alias "FindWindowA " (ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib
"user32 " (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare
Function GetWindowText Lib "user32 " Alias "GetWindowTextA " (ByVal hwnd As
Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare
Function SetParent Lib "user32 " (ByVal hWndChild As Long, ByVal hWndNewParent
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 ShowWindow Lib "user32 " (ByVal hwnd As Long, ByVal
nCmdShow As Long) As Long
Public Declare Function DrawMenuBar Lib "user32 "
(ByVal hwnd As Long) As Long
Public Const WS_SYSMENU = &H80000
Public Sub RemoveSysButton(ByVal hHwnd As Long)
Dim lWnd As Long
lWnd = GetWindowLong(hHwnd, GWL_STYLE)
lWnd = lWnd And Not (WS_SYSMENU)
lWnd = SetWindowLong(hHwnd, GWL_STYLE, lWnd)
DrawMenuBar hHwnd
End
Sub
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim
test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While
test_hwnd <> 0
If GetParent(test_hwnd) = 0 Then
test_thread_id =
GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd =
GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Public Sub
SetFormStyle(hwnd)
Dim IStyle As Long
IStyle = GetWindowLong(hwnd,
GWL_STYLE)
IStyle = IStyle And Not WS_CAPTION And Not WS_EX_APPWINDOW
SetWindowLong hwnd, GWL_STYLE, IStyle
ShowWindow hwnd, SW_SHOW
DrawMenuBar hwnd
End Sub
form中:
Set XL = CreateObject(
"excel.application ")
xlHwnd = FindWindow( "XLMAIN ", XL.Caption)
oldHwnd = GetParent(xlHwnd)
Call SetFormStyle(xlHwnd)
l =
SetParent(xlHwnd, Me.hwnd)
XL.Workbooks.Open FileName:= "要打开的文档 "
RemoveSysButton xlHwnd
XL.WindowState = xlNormal
XL.Height =
Me.Height / 20
XL.Width = Me.Width / 20
XL.Top = 0
XL.Left = 0
大体就是这样的,在此基础上再完善一下就达到要求了。
我用OLE把它嵌入到里面,不过每次双击以后,出来的Excel大小我无法控制
(我不想用对象的方式来操作Excel,因为我要把编辑表格的界面提供给用户)
bas中:
Public XL As Excel.Application, xlHwnd As Long
Public
Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long)
Public
Const WS_CAPTION As Long = &HC00000
Public Const SW_SHOW As Long = 5
Public Const WS_EX_APPWINDOW = &H40000
Public Const SW_SHOWMAXIMIZED
= 3
Public Const GWL_STYLE As Long = -16
Public Const GW_HWNDNEXT =
2
Public Declare Function GetWindowThreadProcessId Lib "user32 " (ByVal
hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function
GetParent Lib "user32 " (ByVal hwnd As Long) As Long
Public Declare Function
FindWindow Lib "user32 " Alias "FindWindowA " (ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib
"user32 " (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare
Function GetWindowText Lib "user32 " Alias "GetWindowTextA " (ByVal hwnd As
Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare
Function SetParent Lib "user32 " (ByVal hWndChild As Long, ByVal hWndNewParent
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 ShowWindow Lib "user32 " (ByVal hwnd As Long, ByVal
nCmdShow As Long) As Long
Public Declare Function DrawMenuBar Lib "user32 "
(ByVal hwnd As Long) As Long
Public Const WS_SYSMENU = &H80000
Public Sub RemoveSysButton(ByVal hHwnd As Long)
Dim lWnd As Long
lWnd = GetWindowLong(hHwnd, GWL_STYLE)
lWnd = lWnd And Not (WS_SYSMENU)
lWnd = SetWindowLong(hHwnd, GWL_STYLE, lWnd)
DrawMenuBar hHwnd
End
Sub
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim
test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While
test_hwnd <> 0
If GetParent(test_hwnd) = 0 Then
test_thread_id =
GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
test_hwnd =
GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Public Sub
SetFormStyle(hwnd)
Dim IStyle As Long
IStyle = GetWindowLong(hwnd,
GWL_STYLE)
IStyle = IStyle And Not WS_CAPTION And Not WS_EX_APPWINDOW
SetWindowLong hwnd, GWL_STYLE, IStyle
ShowWindow hwnd, SW_SHOW
DrawMenuBar hwnd
End Sub
form中:
Set XL = CreateObject(
"excel.application ")
xlHwnd = FindWindow( "XLMAIN ", XL.Caption)
oldHwnd = GetParent(xlHwnd)
Call SetFormStyle(xlHwnd)
l =
SetParent(xlHwnd, Me.hwnd)
XL.Workbooks.Open FileName:= "要打开的文档 "
RemoveSysButton xlHwnd
XL.WindowState = xlNormal
XL.Height =
Me.Height / 20
XL.Width = Me.Width / 20
XL.Top = 0
XL.Left = 0
大体就是这样的,在此基础上再完善一下就达到要求了。
2016-07-12
展开全部
1.部件-添加-可插入对象--选择excel 表格就可以在窗体添加该表格控件
2.工程-引用-Microsoft Excel 11.0 Object Library
下面给个简单的例子
Private Sub Command1_Click()
Dim xlExcel As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim AppExcel As Object
Set xlExcel = CreateObject("Excel.Application")
xlExcel.Workbooks.Open "C:\test.xls"
Set xlBook = xlExcel.Workbooks("test.xls")
Set xlSheet = xlBook.Worksheets(1)
Text1.Text = xlSheet.Cells(1, 1).Value
Text1.Text = Text1.Text & "ADD"
xlSheet.Cells(1, 1).Value = Text1.Text
Application.DisplayAlerts = False
xlBook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub
2.工程-引用-Microsoft Excel 11.0 Object Library
下面给个简单的例子
Private Sub Command1_Click()
Dim xlExcel As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim AppExcel As Object
Set xlExcel = CreateObject("Excel.Application")
xlExcel.Workbooks.Open "C:\test.xls"
Set xlBook = xlExcel.Workbooks("test.xls")
Set xlSheet = xlBook.Worksheets(1)
Text1.Text = xlSheet.Cells(1, 1).Value
Text1.Text = Text1.Text & "ADD"
xlSheet.Cells(1, 1).Value = Text1.Text
Application.DisplayAlerts = False
xlBook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询