后期绑定的ExcelApplication

水如烟 2006-12-25 04:13:37
只可惜,利用不了事件.好长的,现在还在做着,看看能不能做全.
为了设计方便,目前在某些类中还是引用了Excel,最后定稿后,再去掉引用,相关变量全改为Object.

示例:
Public Class Form1

Private gApplication As LzmTW.MSOffice.Excel.ExcelApplication
Private gWorksheet As LzmTW.MSOffice.Excel.Worksheet
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
gApplication = New LzmTW.MSOffice.Excel.ExcelApplication
gApplication.Visible = True
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
gApplication.Quit()
End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
gApplication.Workbooks.Add()
gWorksheet = gApplication.ActiveWorksheet

gWorksheet.Rows(10).Select()
Console.WriteLine(gWorksheet.Rows.Count)
End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

With gWorksheet.Range(gWorksheet.Cells(1, 2), gWorksheet.Cells(5, 5))
.Value = "AA"
With .Borders(LzmTW.MSOffice.XlBordersIndex.xlEdgeRight)
.LineStyle = LzmTW.MSOffice.XlLineStyle.xlDouble
.Color.SetValue(Color.Blue)
.Weight = LzmTW.MSOffice.XlBorderWeight.xlHairline
End With

Console.WriteLine(.Rows.Count)

.Rows(2).Select()
End With
End Sub

End Class
...全文
244 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
jshyjyw 2007-01-03
  • 打赏
  • 举报
回复
没注释的代码看得好累
水如烟 2006-12-25
  • 打赏
  • 举报
回复
Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Public Class ExcelApplication
Inherits ApplicationBase

Private gblnNotDisplayAlerts As Boolean

Public Shadows ReadOnly Property Application() As Microsoft.Office.Interop.Excel.Application
Get
Return CType(MyBase.Application, Microsoft.Office.Interop.Excel.Application)
End Get
End Property

Sub New()
MyBase.New(ApplicationEnum.Excel)
End Sub

Protected Overrides Sub SaveDefaultPropertiesWhenApplicationInitialize()
gblnNotDisplayAlerts = Me.Application.DisplayAlerts

MyBase.SaveDefaultPropertiesWhenApplicationInitialize()
End Sub

Protected Overrides Sub InitializeDefaultPropertyiesWhenApplicationStart()
Me.Application.DisplayAlerts = False

MyBase.InitializeDefaultPropertyiesWhenApplicationStart()
End Sub

Protected Overrides Sub ResetDefaultPropertiesBeforeApplicationRelease()
Me.Application.DisplayAlerts = Me.gblnNotDisplayAlerts

MyBase.ResetDefaultPropertiesBeforeApplicationRelease()
End Sub

Protected Overrides Sub RealseInternalComObjectsBeforeApplicationRelease()
If gWorkbooks IsNot Nothing Then

gWorkbooks.CloseAll()

End If

MyBase.RealseInternalComObjectsBeforeApplicationRelease()
End Sub

End Class

End Namespace

Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Partial Class ExcelApplication
Private gWorkbooks As Workbooks

Public Sub SetDisplayAlerts(ByVal IsDisplay As Boolean)
Me.Application.DisplayAlerts = IsDisplay
End Sub

Public ReadOnly Property Workbooks() As Workbooks
Get
SyncLock LzmTW.uRuntimeHelper.InternalSyncObject
If gWorkbooks Is Nothing Then
gWorkbooks = New Workbooks(Me)
End If
End SyncLock
Return gWorkbooks
End Get
End Property

Public ReadOnly Property ActiveWorkbook() As Workbook
Get
Return Workbooks.ActiveWorkbook
End Get
End Property

Public ReadOnly Property ActiveWorksheet() As WorkSheet
Get
Return ActiveWorkbook.Worksheets.ActiveWorkSheet
End Get
End Property

Public ReadOnly Property Selection() As Range
Get
Return ActiveWorksheet.Selection
End Get
End Property
End Class

End Namespace


水如烟 2006-12-25
  • 打赏
  • 举报
回复
Option Strict Off

Namespace LzmTW.MSOffice

Partial Class ApplicationBase

Public Property Visible() As Boolean
Get
Return Me.Application.Visible
End Get
Set(ByVal value As Boolean)
Me.Application.Visible = value
End Set
End Property

''' <summary>
''' 版本号
''' </summary>
Public ReadOnly Property Version() As String
Get
Return Me.Application.Version
End Get
End Property

''' <summary>
''' 默认文件地址
''' </summary>
''' <remarks>一般在MyDocuments目录下,按具体情形重载</remarks>
Public Overridable ReadOnly Property DefaultFilePath() As String
Get
Return System.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
End Get
End Property

''' <summary>
''' 稍停数秒
''' </summary>
''' <param name="seconds">秒数</param>
''' <remarks></remarks>
Protected Sub WaitingSeconds(ByVal seconds As Integer)
Dim tmpNow As Date = Now
While Now.Subtract(tmpNow).Seconds < seconds
Windows.Forms.Application.DoEvents()
End While
End Sub

''' <summary>
''' 宏安全级别,适合于2003以上
''' </summary>
Public Property AutomationSecurity() As MsoAutomationSecurityEnum
Get
Return Me.Application.AutomationSecurity
End Get
Set(ByVal value As MsoAutomationSecurityEnum)
Me.Application.AutomationSecurity = value
End Set
End Property
End Class

End Namespace

水如烟 2006-12-25
  • 打赏
  • 举报
回复
Namespace LzmTW.MSOffice
Public MustInherit Class ApplicationBase
Implements IDisposable

Private gApplicationComObject As ApplicationProcessService

Private gSecurityLevel As MsoAutomationSecurityEnum '宏安全级别

Public ReadOnly Property Application() As Object
Get
Return gApplicationComObject.CurrentApplication
End Get
End Property

Friend Sub New(ByVal office As ApplicationEnum)
gApplicationComObject = New ApplicationProcessService(office)

'读取和保留默认配置
SaveDefaultPropertiesWhenApplicationInitialize()

'初始有关参数
InitializeDefaultPropertyiesWhenApplicationStart()
End Sub

''' <summary>
''' 退出主进程
''' </summary>
Public Sub Quit()
'释放其它对象,如Excel.Worksheets
Try
RealseInternalComObjectsBeforeApplicationRelease()
Catch ex As Exception

End Try


'置回默认设置,如Excel.DisplayAlerts = True
Try
ResetDefaultPropertiesBeforeApplicationRelease()
Catch ex As Exception

End Try


'释放主进程,如Excel
Try
gApplicationComObject.Quit()
Catch ex As Exception
End Try


End Sub

''' <summary>
''' 读取与保存默认设置
''' </summary>
Protected Overridable Sub SaveDefaultPropertiesWhenApplicationInitialize()
gSecurityLevel = Me.AutomationSecurity

End Sub

''' <summary>
''' 初始有关参数
''' </summary>
Protected Overridable Sub InitializeDefaultPropertyiesWhenApplicationStart()
Me.AutomationSecurity = MsoAutomationSecurityEnum.SecurityLow '降低宏安全级别,使打开数据库时不必出现选择是否打开对话框
End Sub

''' <summary>
''' 置回默认设置
''' </summary>
Protected Overridable Sub ResetDefaultPropertiesBeforeApplicationRelease()
Me.AutomationSecurity = Me.gSecurityLevel
End Sub

''' <summary>
''' 退出其它Com对象
''' </summary>
Protected Overridable Sub RealseInternalComObjectsBeforeApplicationRelease()

End Sub


Private disposedValue As Boolean = False

Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then

If gApplicationComObject IsNot Nothing Then
Me.Quit()
End If

End If

' TODO: 释放共享的非托管资源

End If
Me.disposedValue = True
End Sub

Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
GC.Collect(2)
End Sub

Protected Overrides Sub Finalize() '如果没有显式调用Quit或Dispose,则错
Dispose()
MyBase.Finalize()
End Sub
End Class
End Namespace

水如烟 2006-12-25
  • 打赏
  • 举报
回复
Namespace LzmTW.MSOffice
Public Enum MsoAutomationSecurityEnum
SecurityLow = 1
SecurityByUI = 2
SecurityForceDisable = 3
End Enum
End Namespace

Option Strict Off

Namespace LzmTW.MSOffice

Friend Class ApplicationProcessService
Private gBeforeHandleCreated As Date
Private gAfterHandleCreated As Date

Private gCurrentComObject As Object
Private gCurrentOffice As ApplicationEnum

Public ReadOnly Property CurrentOfficeType() As ApplicationEnum
Get
Return gCurrentOffice
End Get
End Property

Public ReadOnly Property CurrentApplication() As Object
Get
Return gCurrentComObject
End Get
End Property

Sub New(ByVal office As ApplicationEnum)
gCurrentOffice = office

InternalCreateComObject()
End Sub

Public Sub Quit()
gCurrentComObject.Quit()
Threading.Thread.Sleep(500)

InternalReleaseComObject()
End Sub

Private Sub InternalCreateComObject()
gBeforeHandleCreated = Now

Select Case gCurrentOffice
Case ApplicationEnum.Access
gCurrentComObject = CreateObject(ApplicationObject.Access)
Case ApplicationEnum.Excel
gCurrentComObject = CreateObject(ApplicationObject.Excel)
Case ApplicationEnum.Word
gCurrentComObject = CreateObject(ApplicationObject.Word)
End Select

gAfterHandleCreated = Now
End Sub

Private Sub InternalReleaseComObject()
ApplicationProcess.ReleaseComObject(gCurrentComObject)
Threading.Thread.Sleep(500)

Select Case gCurrentOffice
Case ApplicationEnum.Access
ApplicationProcess.KillProcess(ApplicationProcess.Access, gBeforeHandleCreated, gAfterHandleCreated)
Case ApplicationEnum.Excel
ApplicationProcess.KillProcess(ApplicationProcess.Excel, gBeforeHandleCreated, gAfterHandleCreated)
Case ApplicationEnum.Word
ApplicationProcess.KillProcess(ApplicationProcess.Word, gBeforeHandleCreated, gAfterHandleCreated)
End Select

End Sub

End Class

End Namespace
水如烟 2006-12-25
  • 打赏
  • 举报
回复
Namespace LzmTW.MSOffice
Friend Enum ApplicationEnum
Access
Excel
Word
End Enum
End Namespace

Namespace LzmTW.MSOffice
Friend Class ApplicationObject
Friend Const Access As String = "Access.Application"
Friend Const Excel As String = "Excel.Application"
Friend Const Word As String = "Word.Application"
End Class
End Namespace

Namespace LzmTW.MSOffice
Friend Class ApplicationProcess
Friend Const Access As String = "MSACCESS"
Friend Const Excel As String = "EXCEL"
Friend Const Word As String = "WINWORD"

Friend Shared Sub ReleaseComObject(ByVal comObj As Object)
If Not System.Runtime.InteropServices.Marshal.IsComObject(comObj) Then Return

System.Runtime.InteropServices.Marshal.ReleaseComObject(comObj)
comObj = Nothing
End Sub

Friend Shared Sub KillProcess(ByVal processName As String, ByVal beforeProcessStartTime As Date, ByVal afterProcessStartTime As Date)

Dim mProcessList As Process()
Dim mProcessStartTime As Date

mProcessList = Process.GetProcessesByName(processName)

For Each tmpProcess As Process In mProcessList
mProcessStartTime = tmpProcess.StartTime
If mProcessStartTime.CompareTo(beforeProcessStartTime) > 0 AndAlso mProcessStartTime.CompareTo(afterProcessStartTime) < 0 Then
tmpProcess.Kill()
End If
Next

End Sub

Friend Shared Sub KillProcess(ByVal processName As String)

Dim mProcessList As Process()

mProcessList = Process.GetProcessesByName(processName)

For Each tmpProcess As Process In mProcessList
tmpProcess.Kill()
Next

End Sub
End Class
End Namespace
水如烟 2006-12-25
  • 打赏
  • 举报
回复
Font:

Namespace LzmTW.MSOffice
Public Class Font

Private gFont As Microsoft.Office.Interop.Excel.Font

Friend Sub New(ByVal font As Microsoft.Office.Interop.Excel.Font)
gfont = font
End Sub

Public ReadOnly Property Color() As Color
Get
Return New Color(gfont)
End Get
End Property

Public Property Style() As xlFontStyle
Get
Return CType([Enum].Parse(GetType(xlFontStyle), gfont.FontStyle.ToString.Replace(" "c, "_")), xlFontStyle)
End Get
Set(ByVal value As xlFontStyle)
gfont.FontStyle = value.ToString.Replace("_"c, " ")
End Set
End Property

Public Property Size() As Single
Get
Return CSng(gfont.Size)
End Get
Set(ByVal value As Single)
gfont.Size = value
End Set
End Property

Public Property Name() As String
Get
Return CStr(gFont.Name)
End Get
Set(ByVal value As String)
gFont.Name = value
End Set
End Property

Public Property Bold() As Boolean
Get
Return CBool(gFont.Bold)
End Get
Set(ByVal value As Boolean)
gFont.Bold = value
End Set
End Property

Public Property Background() As xlBackground
Get
Return CType(gFont.Background, xlBackground)
End Get
Set(ByVal value As xlBackground)
gFont.Background = value
End Set
End Property

Public Property Italic() As Boolean
Get
Return CBool(gFont.Italic)
End Get
Set(ByVal value As Boolean)
gFont.Italic = value
End Set
End Property

Public Property OutlineFont() As Boolean
Get
Return CBool(gFont.OutlineFont)
End Get
Set(ByVal value As Boolean)
gFont.OutlineFont = value
End Set
End Property

Public Property Shadow() As Boolean
Get
Return CBool(gFont.Shadow)
End Get
Set(ByVal value As Boolean)
gFont.Shadow = value
End Set
End Property

Public Property Strikethrough() As Boolean
Get
Return CBool(gFont.Strikethrough)
End Get
Set(ByVal value As Boolean)
gFont.Strikethrough = value
End Set
End Property

Public Property Subscript() As Boolean
Get
Return CBool(gFont.Subscript)
End Get
Set(ByVal value As Boolean)
gFont.Subscript = value
End Set
End Property

Public Property Superscript() As Boolean
Get
Return CBool(gFont.Superscript)
End Get
Set(ByVal value As Boolean)
gFont.Superscript = value
End Set
End Property

Public Property Underline() As XlUnderlineStyle
Get
Return CType(gFont.Underline, XlUnderlineStyle)
End Get
Set(ByVal value As XlUnderlineStyle)
gFont.Underline = value
End Set
End Property

End Class
End Namespace

水如烟 2006-12-25
  • 打赏
  • 举报
回复
Cells:

Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Public Class Cells
Inherits Range

Friend Sub New(ByVal parent As Worksheet, ByVal row As Integer, Optional ByVal col As Integer = 1)
Me.gParent = parent
Me.gComRange = CType(parent.gComWorksheet.Cells(row, col), Microsoft.Office.Interop.Excel.Range)
End Sub

End Class

End Namespace

Columns:
Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Public Class Columns
Inherits Range

Private gComColumn As Microsoft.Office.Interop.Excel.Range

Friend Sub New(ByVal parent As Worksheet)
Me.gParent = parent
Me.gComColumn = CType(parent.gComWorksheet.Columns, Microsoft.Office.Interop.Excel.Range)
End Sub

Friend Sub New(ByVal parent As Range)
Me.gParent = parent.gParent
Me.gComColumn = parent.gComRange
End Sub

Default Public ReadOnly Property Item(ByVal index As Integer) As Columns
Get
Me.gComRange = CType(gComColumn.Columns(index), Microsoft.Office.Interop.Excel.Range)
Return Me
End Get
End Property

Public ReadOnly Property Count() As Integer
Get
Return gComColumn.Columns.Count
End Get
End Property

End Class

End Namespace

Rows:
Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Public Class Rows
Inherits Range

Private gComRow As Microsoft.Office.Interop.Excel.Range

Friend Sub New(ByVal parent As Worksheet)
Me.gParent = parent
Me.gComRow = CType(parent.gComWorksheet.Columns, Microsoft.Office.Interop.Excel.Range)
End Sub

Friend Sub New(ByVal parent As Range)
Me.gParent = parent.gParent
Me.gComRow = parent.gComRange
End Sub

Default Public ReadOnly Property Item(ByVal index As Integer) As Rows
Get
Me.gComRange = CType(gComRow.Rows(index), Microsoft.Office.Interop.Excel.Range)
Return Me
End Get
End Property

Public ReadOnly Property Count() As Integer
Get
Return gComRow.Columns.Count
End Get
End Property

End Class

End Namespace
水如烟 2006-12-25
  • 打赏
  • 举报
回复
Range:

Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Public Class Range
Protected Friend gParent As Worksheet
Protected Friend gComRange As Microsoft.Office.Interop.Excel.Range

Protected Sub New()
End Sub

Friend Sub New(ByVal parent As Worksheet, ByVal cell1 As Object, Optional ByVal cell2 As Object = Nothing)
gParent = parent
gComRange = Me.InternalGetComRange(parent, cell1, cell2)
End Sub

Private Function InternalGetComRange(ByVal parent As Worksheet, ByVal cell1 As Object, Optional ByVal cell2 As Object = Nothing) As Microsoft.Office.Interop.Excel.Range
Dim mResult As Microsoft.Office.Interop.Excel.Range

If cell2 Is Nothing Then
If TypeOf cell1 Is String Then
mResult = parent.gComWorksheet.Range(cell1)
Else
mResult = parent.gComWorksheet.Range(CType(cell1, Cells).gComRange, CType(cell1, Cells).gComRange)
End If
Else
mResult = parent.gComWorksheet.Range(CType(cell1, Cells).gComRange, CType(cell2, Cells).gComRange)
End If
Return mResult
End Function

Protected Function InternalCreateInstance(ByVal range As Microsoft.Office.Interop.Excel.Range) As Range
Dim mRange As New Range
mRange.gParent = gParent
mRange.gComRange = range
Return mRange
End Function

Public ReadOnly Property Worksheet() As Worksheet
Get
Return gParent
End Get
End Property

Public ReadOnly Property Workbook() As Workbook
Get
Return Worksheet.Workbook
End Get
End Property

Public ReadOnly Property Application() As ExcelApplication
Get
Return Workbook.Application
End Get
End Property

Public Function [Select]() As Range
gComRange.Select()
Return Selection
End Function

End Class

End Namespace

Imports Microsoft.Office.Interop.Excel
Namespace LzmTW.MSOffice.Excel

Partial Class Range
Public Property Value() As Object
Get
Return gComRange.Value
End Get
Set(ByVal value As Object)
gComRange.Value = value
End Set
End Property

Public Property Formula() As String
Get
Return CStr(gComRange.Formula)
End Get
Set(ByVal value As String)
gComRange.Formula = value
End Set
End Property

Public ReadOnly Property Row() As Integer
Get
Return gComRange.Row
End Get
End Property

Public ReadOnly Property Col() As Integer
Get
Return gComRange.Column
End Get
End Property

Public ReadOnly Property Selection() As Range
Get
Return InternalCreateInstance(CType(gParent.Workbook.Application.Application.Selection, Microsoft.Office.Interop.Excel.Range))
End Get
End Property

Public ReadOnly Property Cells() As Cells()
Get
Dim mResult(-1) As Cells

For Each cell As Microsoft.Office.Interop.Excel.Range In Me.gComRange.Cells
uSystem.uCollection.CommonFunction.Append(Of Cells)(mResult, New Cells(gParent, cell.Row, cell.Column))
Next

Return mResult
End Get
End Property

Public ReadOnly Property Font() As Font
Get
Return New Font(Me.gComRange.Font)
End Get
End Property

Public ReadOnly Property Interior() As Interior
Get
Return New Interior(Me.gComRange.Interior)
End Get
End Property

Public ReadOnly Property Borders() As Borders
Get
Return New Borders(Me.gComRange.Borders)
End Get
End Property

Public ReadOnly Property Columns() As Columns
Get
Return New Columns(Me)
End Get
End Property

Public ReadOnly Property Rows() As Rows
Get
Return New Rows(Me)
End Get
End Property


End Class

End Namespace

16,553

社区成员

发帖
与我相关
我的任务
社区描述
VB技术相关讨论,主要为经典vb,即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧