Dim dataexcel As Excel.Application
Dataexcel.Workbooks.Add
With Dataexcel.Workbooks(1).Sheets(j).Range("a1:i4").Characters.Font
.Italic = True
.Color = RGB(0, 0, 153)
End With
主要是設置RANGE的各種屬性,其它用法請看EXCEL自帶的VBA說明
Dataexcel.Workbooks.Add
With Dataexcel.Workbooks(1).Sheets(j).Range("a1:i4").Characters.Font
.Italic = True
.Color = RGB(0, 0, 153)
End With
主要是設置RANGE的各種屬性,其它用法請看EXCEL自帶的VBA說明
http://dapha.net/vb/list.asp?id=587
http://dapha.net/vb/list.asp?id=1613
Select Case Button.Index
Case 1
' SSPanel2.Visible = True
' probar.Value = 0
' Dim myexcel As New Excel.Application, I, J, K As Integer, col As String
' With myexcel
' On Error GoTo excle
' .Application.Visible = False
' .Workbooks.Add
' '***********画字段************
' J = 0
' 'example: b2 ----g2 ’列 本程序从b列,和第2行开始
' For I = 66 To (66 + Rs_temp.Fields.Count - 1) '从rs中头一个字段到最后一个
' col = Chr(I) & "2" 'chr(66)就是b
' Range(col).Select
' ActiveCell.FormulaR1C1 = Rs_temp.Fields(J).Name '
' J = J + 1
' Next I
' '*************以先横后竖顺序画表***************
' K = 0
' Rs_temp.MoveFirst
' DoEvents
' For J = 3 To 3 + Rs_temp.RecordCount '本程序从b3开始，所以用3
' K = 0
' For I = 66 To (66 + Rs_temp.Fields.Count - 1)
' col = Chr(I) & CStr(J) '得到目标表格的值如 c3
' Range(col).Select
' ActiveCell.FormulaR1C1 = Rs_temp.Fields(K)
' K = K + 1
' Next I
' On Error Resume Next
' probar.Value = probar.Value + 1
' Rs_temp.MoveNext
' If Rs_temp.EOF = True Then
' SSPanel2.Visible = False
' .Application.Visible = True
' End If
' Next J
' End With
'excle:
' MsgBox ("您没有安装excle2000，请先安装excel2000")
Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen1 As Integer
'存字段长度值
Dim Fieldlen()
'Dim xlApp As Excel.Application
'Dim xlBook As Excel.Workbook
'Dim xlSheet As Excel.Worksheet Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1) SSPanel2.Visible = True
probar.Value = 0 'On Error GoTo excle
With Rs_temp
.MoveLast If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Sub
End If '记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .Fields.Count ReDim Fieldlen(Icolcount)
.MoveFirst For Irow = 1 To Irowcount + 1
For Icol = 1 To Icolcount
Select Case Irow
'在Excel中的第一行加标题
Case 1
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
'将数组FIELDLEN()存为第一条记录的字段长
Case 2
If IsNull(.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
'如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
Else
Fieldlen(Icol) = LenB(.Fields(Icol - 1))
End If xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
'Excel列宽等于字段长
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
'向Excel的CellS中写入字段值
Case Else
If IsNull(.Fields(Icol - 1)) Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
Else
Fieldlen1 = LenB(.Fields(Icol - 1))
End If If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = IIf(Fieldlen1 > 255, 255, Fieldlen1)
'表格列宽等于较长字段长
Fieldlen(Icol) = IIf(Fieldlen1 > 255, 255, Fieldlen1)
'数组Fieldlen(Icol)中存放最大字段长度值
Else
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
End If xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
End Select
Next If Irow > 2 Then
If Not .EOF Then .MoveNext
End If
If Not .EOF Then
If Irow < Irowcount Then
probar.Value = probar.Value + 1
End If
End If
Next '网格线
With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With '*!* 页眉、填报单位、报表时间、单位
With xlSheet.PageSetup
.LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称：" ' & Gsmc
.CenterHeader = "&""楷体_GB2312,常规""业务数据综合查询表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期："
.RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位："
.LeftFooter = "&""楷体_GB2312,常规""&10制表人："
.CenterFooter = "&""楷体_GB2312,常规""&10制表日期："
.RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
End With '显示表格
Dim ExclFileName As String
ExclFileName = App.path & "\业务数据综合查询表.xls"
If Dir(ExclFileName) <> "" Then
Kill ExclFileName
End If
xlSheet.SaveAs (ExclFileName)
SSPanel2.Visible = False
xlApp.Application.Visible = True
'交还控制给Excel
'xlSheet.PrintPreview
'xlApp.Quit
End With
'excle:
' MsgBox ("您没有安装 Excle2000，请先安装 Excel2000 ！")
Case 2
Unload Me
End Select
End Sub
您可以通过以下方法改变Excel文件单元格的格式：
首先，打开VB工程，在Project->Reference中添加Microsoft Excel Object Libaray然后在您需要操作Excel的地方添加如下代码:
Dim app As Excel.Application
Dim books As Excel.Workbooks
Dim sheets As Worksheets
Dim sheet As Worksheet
Set app = CreateObject("Excel.Application")
Set books = app.Workbooks
books.Add
app.Visible = True
Set sheet = app.Worksheets("Sheet1")
sheet.Activate
'改变字体
Range("D13").Select
ActiveCell.FormulaR1C1 = "Change Font"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Bernard MT Condensed"
.FontStyle = "Regular"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'设置字体颜色为红色
Range("C4").Select
ActiveCell.FormulaR1C1 = "Change Color"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "宋体"
.FontStyle = "Regular"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
'增加边框
Range("E5:H10").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
sheet.SaveAs "C:\Test.xls"
books.Close
app.Quit如果您希望了解如何改变单元格的字体，边框，或者颜色，您有以下两个办法：
1、在Microsoft Excel 中，首先在工具->宏->记录新宏，开始记录一个新的宏，然后手动选中单元格，并改变单元格的格式，完成目的以后，选择停止记录。接着在工具->宏中打开Visual Basic编辑器，在模块中会有一段相应的代码，对应着您刚才的操作，您可以把这段代码写到Visual Basic的工程中，就通过程序实现了设置单元格格式。2、您可以参考MSDN文档：
Microsoft Office XP Developer Working with Microsoft Excel Objects
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/modcore/html/deovrUnderstandingExcelApplicationObject.asp 学习Excel对象的使用，同时参考MSDN相关的内容学习各种属性的使用方法。希望我的回答对您有所帮助。微软全球技术中心 VB技术支持
本贴子以“现状”提供且没有任何担保，同时也没有授予任何权利。具体事项可参见使用条款(http://support.microsoft.com/directory/worldwide/zh-cn/community/terms_chs.asp)。