Attribute VB_Name = "Module1"
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
Public Function merge(str1 As String, str2 As String)
Excel.Range(str1 & ":" &
str2).Select
Excel.Selection.merge
Excel.Selection.VerticalAlignment = xlVAlignCenter
Excel.Selection.HorizontalAlignment = xlCenter
Excel.Selection.Orientation = xlVertical
End Function
Public Function quit()
Dim ret As
Integer
ret =
MsgBox("是否关闭并保存Excel?", vbYesNo)
If (ret =
vbYes) Then
Dim strname As String
strname = InputBox("please input excel file name")
ExcelWorkbook.SaveAs strname
Excel.Application.quit
Set Excel = Nothing
End If
End Function
Public Function border(str1 As String, str2 As String)
Excel.Range(str1 & ":" &
str2).Select
Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Excel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End
With
End Function
Public Function Border_bold(str1 As String, str2 As
String)
Excel.Range(str1 & ":" &
str2).Select
Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With
Excel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End
With
With
Excel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End
With
Excel.Selection.Borders(xlInsideVertical).LineStyle = xlNone
Excel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Function
Public Function writeExcel()
Dim
returnObj As ComSheet
Dim sheet As
Integer
Dim basePnt
As Variant
Dim rangeRow
As Integer
Dim
rangeColumn As Integer
Dim
rangeRowMax As Integer
Dim
rangeColumnMax As Integer
Dim cell1 As
Object
Dim cell2 As
Object
On Error
Resume Next
Set Excel =
CreateObject("Excel.Application")
Set
ExcelWorkbook = Excel.Workbooks.Add
Set
ExcelSheet = Excel.ActiveSheet
Excel.Visible = True
On Error
Resume Next
' The
following example waits for a selection from the user
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an
object"
Dim
name
>
Dim str As String
str =
returnObj.TextString
If Not (name
= "TDbSheet") Then
Exit Function
End If
nRowNum =
returnObj.RowNum
nColumnNum =
returnObj.ColumnNum
For j = 0 To
nColumnNum - 1 Step 1
For i = 0 To nRowNum - 1 Step 1
If (returnObj.IsRange(i, j)) Then
rangeRow = returnObj.rangeRow(i, j)
rangeColumn = returnObj.rangeColumn(i, j)
rangeRowMax = returnObj.rangeRowMax(i, j)
rangeColumnMax = returnObj.rangeColumnMax(i, j)
Set cell1 = ExcelSheet.Cells(rangeRow + 1, rangeColumn + 1)
Set cell2 = ExcelSheet.Cells(rangeRowMax + 1, rangeColumnMax +
1)
Excel.Range(cell1, cell2).Select
Excel.Selection.merge
Excel.Selection.VerticalAlignment = xlVAlignCenter
Excel.Selection.HorizontalAlignment = xlCenter
'Excel.Selection.Orientation = xlVertical