标签： 编程

Public Function IsInArray(ByVal sData As String, ByVal vData As Variant) As Boolean ‘某字符串是否在某一维数组中
IsInArray = False
If Not IsArray(vData) Then Exit Function
If IsEmptyArray(vData) Then Exit Function
Dim I As Integer
For I = LBound(vData) To UBound(vData)
If sData = vData(I) Then IsInArray = True
Next I
End Function

Public Function IsEmptyArray(ByVal sArray As Variant) As Boolean ‘判断一维数组为空或者尚未初始化
‘类似 Dim TestArray(0 To 2) As String，一经申明，各元素即被赋 “” 值，IsEmptyArray 为 False；
‘类似 Dim TestArray() As String，虽经申明，仍为空数组，IsEmptyArray 为 True。
Dim I As Integer, J As Integer
On Error GoTo ERR_EMPTY
I = UBound(sArray) ‘试错
If LBound(sArray) > UBound(sArray) Then GoTo ERR_EMPTY
IsEmptyArray = False
On Error GoTo 0
Exit Function
ERR_EMPTY:
IsEmptyArray = True
On Error GoTo 0
End Function

Public Function IndexInArray(ByVal sData As String, ByVal vData As Variant) As Integer ‘某数值在某一维数组中的位次(以最小号为准, 不存在则为 -1)
Dim I As Integer, J As Integer
IndexInArray = -1
If Not IsArray(vData) Then Exit Function
If IsEmptyArray(vData) Then Exit Function
For I = LBound(vData) To UBound(vData)
If LCase(sData) = LCase(vData(I)) Then
IndexInArray = I
Exit For
End If
Next I
End Function

Public Sub CleanUpArray(vData As Variant) ‘剔除数组中的重复数据
If Not IsArray(vData) Then Exit Sub ‘数组判断
If IsEmptyArray(vData) Then Exit Sub
Dim LO, HI As Integer ‘上下界
LO = LBound(vData)
HI = UBound(vData)
Dim I, J, KCount As Integer
KCount = 0 ‘计数器
Dim DupeIndex() As String ‘重复数据的序号组成的数组，记后不记前
For I = HI To LO Step -1
For J = I – 1 To LO Step -1
If vData(I) = vData(J) Then
KCount = KCount + 1
ReDim Preserve DupeIndex(1 To KCount) As String
DupeIndex(KCount) = CStr(I)
Exit For
End If
Next J
Next I
If KCount > 0 Then ‘有重复
Dim iCount As Integer
iCount = LO – 1 ‘计数器
Dim TempArray() As String
For I = LO To HI
If Not IsInArray(CStr(I), DupeIndex()) Then ‘首次出现或未重复的数据
iCount = iCount + 1
ReDim Preserve TempArray(LO To iCount) As String
TempArray(iCount) = vData(I)
End If
Next I
ReDim vData(LO To iCount) ‘ As String ‘重新赋值并返回
For I = LO To iCount
vData(I) = TempArray(I)
Next I
Else
‘无重复，不处理
End If
Erase DupeIndex
End Sub

Dim oExcel As Object
Call BindExcel(True)

Dim oBook As Object
Dim oSheet As Object
Set oBook = oExcel.ActiveWorkBook
Set oSheet = oBook.ActiveSheet

oSheet.Cells(1, 1) = “1001”
oSheet.Cells(1, 2) = “1003”
oSheet.Cells(1, 3) = “1005”
oSheet.Cells(1, 4) = “1010”
oSheet.Cells(1, 5) = “1040”
oSheet.Cells(2, 1) = “属性
oSheet.Cells(2, 2) = “PROFILE”
oSheet.Cells(2, 3) = “467”
oSheet.Cells(3, 4) = “26.3333,236.0000,0.0000|26.3333,268.0000,0.0000” ‘两组坐标值
oSheet.Cells(3, 5) = “6885.44

‘绑定 Microsoft Excel
Dim oExcel As Object ‘Microsoft Excel Application 本身
Call BindExcel(True)
Dim oBook As Object ‘Microsoft Excel 多工作薄之一
Dim oSheet As Object ‘工作薄的工作表之一

‘打开并绑定文件 D:/Test.xls
Set oBook = oExcel.Application.WorkBooks.Open(“D:/Test.xls”)

‘绑定已经打开文件 Demo.xls
Set oBook = oExcel.WorkBooks.Item(“Demo.xls”)

‘新建文件并绑定
Set oBook = oExcel.WorkBooks.Add

‘绑定已经打开的当前文件
Set oBook = oExcel.ActiveWorkBook

绑定已有工作表 Sheet1
Set oSheet = oBook.Sheets(“Sheet1”)

‘新建工作表并绑定
Set oSheet = oBook.Worksheets.Add
oSheet.Name = “New Sheet”

‘绑定已经打开的当前工作表
Set oSheet = oBook.ActiveSheet

‘另存文件并指定格式
oBook.SaveAs “D:/TestBack.xls”, FileFormat:=18 ‘Excel Format

‘退出 Microsoft Excel 并释放资源
oExcel.Quit
Set oExcel = Nothing
Set oBook = Nothing
Set oSheet = Nothing

Dim oWord As Object
Call BindWord(True)

Dim oDocument As Object
Set oDocument = oWord.ActiveDocument
Call NameList

Public Sub NameList()
On Error Resume Next
Dim RowsCount, ColsCount As Integer
With oDocument
.Paragraphs(.Paragraphs.Count).Range.Font.Name = “宋体”
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 12
.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False
.Paragraphs(.Paragraphs.Count).Alignment = 1
.Paragraphs(.Paragraphs.Count).Range.Text = “花名册”
RowsCount = 3
ColsCount = 4
.Tables.Add Range:=.Range(Start:=.Range.End – 1, End:=.Range.End), NumRows:=RowsCount, NumColumns:=ColsCount, DefaultTableBehavior:=1, AutoFitBehavior:=2 ‘wdAutoFitFixed = 0 wdAutoFitContent = 1 wdAutoFitWindow = 2
With .Tables(.Tables.Count)
.Range.Cells(1).Range.Text = “姓名”
.Range.Cells(2).Range.Text = “性别”
.Range.Cells(3).Range.Text = “年龄”
.Range.Cells(4).Range.Text = “职称”
.Range.Cells(5).Range.Text = “张三”
.Range.Cells(6).Range.Text = “男”
.Range.Cells(7).Range.Text = “36”
.Range.Cells(8).Range.Text = “工程师”
.Range.Cells(9).Range.Text = “李四”
.Range.Cells(10).Range.Text = “女”
.Range.Cells(11).Range.Text = “28”
.Range.Cells(12).Range.Text = “预算员”
End With
End With
On Error GoTo 0
End Sub

‘绑定 Microsoft Word
Dim oWord As Object ‘Microsoft Word Application 本身
Call BindWord(True)
Dim oDocument As Object ‘Microsoft Word 多文档之一

‘打开并绑定文件 D:/Test.rtf
Set oDocument = oWord.Application.Documents.Open(“D:/Test.rtf”)

‘绑定已经打开文件 Demo.doc
Set oDocument = oWord.Documents.Item(“Demo.doc”)

‘新建文件并绑定
Set oDocument = oWord.Documents.Add

‘绑定已经打开的当前文件
Set oDocument = oWord.ActiveDocument

‘另存文件并指定格式
oDocument.SaveAs “D:/TestBack”, FileFormat:=6 ‘RTF Format

‘退出 Microsoft Word 并释放资源
oWord.Quit
Set oWord = Nothing
Set oDocument = Nothing