Function 导出电子表格(biaog As Object, wenben As String, biaoti As String)
’ 表格名称 ，字段类型用于导出身份证，标题
’
Dim oExcel As Excel.Application
Dim obook As Excel.Workbook
Dim objExlSht As Excel.Worksheet
Dim listrst() As Variant
Dim X, Y As Long
Dim I, n As Integer
Set oExcel = New Excel.Application
Set obook = oExcel.Workbooks.Add
Set objExlSht = obook.ActiveSheet
With biaog
.Redraw = False
X = biaog.Rows
Y = biaog.Cols
ReDim listrst(X, Y)
For I = 0 To X - 1
For n = 0 To Y - 1
listrst(I, n) = Trim(biaog.TextMatrix(I, n))
Next
Next
.Redraw = True
End With
Dim c, b As Integer
Dim zjzj, hehe As String
'‘Trim '去掉字符序列左边和右边的空格
DoEvents '把控制权交给操作系统，以响应窗口重画、最大化、最小化等要求，避免出现应用程序不响应操作系统请求而被操作系统误以为死机了。
With objExlSht
c = 1
If biaoti <> “” Then '分割标题
b = Len(biaoti)
For I = 1 To b
zjzj = Mid(biaoti, I, 1)
If zjzj = “,” Then
c = c + 1
If c <> 4 Then
oExcel.Intersect(.Range(.Rows(c ), .Rows(c )), .Range(.Columns(1), .Columns(1))) = hehe
End If
If c = 4 Then
oExcel.Intersect(.Range(.Rows(c + X), .Rows(c + X)), .Range(.Columns(1), .Columns(1))) = hehe
End If
hehe = “”
Else
hehe = hehe & zjzj
End If
Next I
End If
If wenben <> “” Then '指定那个列 是纯文本 主要防止身份证出现科学计数
b = Len(wenben)
For I = 1 To b
zjzj = Mid(wenben, I, 1)
If zjzj = “,” Then
oExcel.Intersect(.Range(.Rows(1), .Rows(X + c - 1)), .Range(.Columns(Val(hehe)), .Columns(Val(hehe)))).NumberFormat = “@”
hehe = “”
Else
hehe = hehe & zjzj
End If
Next I
End If
On Error Resume Next
oExcel.Intersect(.Range(.Rows(1 + c - 1), .Rows(X + c - 1)), .Range(.Columns(1), .Columns(Y))).Value = listrst
oExcel.Intersect(.Range(.Rows©, .Rows(c + 3)), .Range(.Columns(1), .Columns(Y))).Columns.AutoFit
oExcel.Intersect(.Range(.Rows(1), .Rows(X + c)), .Range(.Columns(1), .Columns(Y))).Font.Size = 9
oExcel.Intersect(.Range(.Rows(1 + c - 1), .Rows(X + c)), .Range(.Columns(1), .Columns(Y))).Borders(xlInsideHorizontal).Weight = xlHairline
oExcel.Intersect(.Range(.Rows(1 + c - 1), .Rows(X + c - 1)), .Range(.Columns(1), .Columns(Y + 1))).Borders(xlInsideVertical).Weight = xlHairline
End With
oExcel.Visible = True
oExcel.Interactive = True
End Function
使用函数
导出电子表格 MSHFlexGrid1, “8,9,10,11,”, “人员基础信息表,”