Excel VBA编程实例Word格式文档下载.docx
- 文档编号:22749355
- 上传时间:2023-02-05
- 格式:DOCX
- 页数:28
- 大小:17.60KB
Excel VBA编程实例Word格式文档下载.docx
《Excel VBA编程实例Word格式文档下载.docx》由会员分享,可在线阅读,更多相关《Excel VBA编程实例Word格式文档下载.docx(28页珍藏版)》请在冰豆网上搜索。
DimTABLENAMEAsString'
待处理的表名
DimcolorIndexAsString'
颜色索引名字
HEADERCOLORINDEX=15
colorIndex=36'
颜色从33开始是比较浅的颜色
TABLENAME="
direct_Price"
关闭所有弹出的警告消息
Application.DisplayAlerts=False
设置需要处理的单元表
Sheets(TABLENAME).Select
'
取单元表的总列数与总行数
cRows=Sheets(TABLENAME).UsedRange.Rows.Count
cColumns=Sheets(TABLENAME).UsedRange.Columns.Count
选择所有的单元格
Range(Cells(1,1),Cells(cRows,cColumns)).Select
设置该表中所有单元行高为11.25
Selection.RowHeight=11.25
设置所有的边框
Selection.Borders(xlDiagonalDown).LineStyle=xlNone
Selection.Borders(xlDiagonalUp).LineStyle=xlNone
WithSelection.Borders(xlEdgeLeft)
.LineStyle=xlContinuous
.Weight=xlThin
.colorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeTop)
WithSelection.Borders(xlEdgeBottom)
WithSelection.Borders(xlEdgeRight)
WithSelection.Borders(xlInsideVertical)
并且拆分所有的单元格
WithSelection
.MergeCells=False'
拆分单格
Columns("
C:
C"
).Select
Selection.InsertShift:
=xlToRight
删除第一列,注意这里必须先拆分单格,再删除第一列,否则一次就会把合并单元格所在列全部删除
Range(Cells(1,1),Cells(1,1)).Select
Selection.EntireColumn.Delete
Selection.EntireColumn.Delete
向表头添加一行
Rows("
1:
1"
Selection.Insert
Columns("
A:
A"
Selection.ColumnWidth=9.29
B:
B"
Selection.ColumnWidth=6.71
Selection.ColumnWidth=15.29
D:
D"
Selection.ColumnWidth=29.86
E:
E"
Selection.ColumnWidth=12.29
F:
F"
设定单元格A1:
A2'
合并A1:
A2单元格
Range("
A1:
A2"
将数据写回
.HorizontalAlignment=xlCenter
.VerticalAlignment=xlCenter
.Orientation=0
.AddIndent=False
.IndentLevel=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=True
往该单元格中写入Usage_Var
ActiveCell.FormulaR1C1="
Price"
设置该单元格字体格式
WithActiveCell.Characters(Start:
=1,Length:
=5).Font
.Name="
Arial"
.FontStyle="
加粗倾斜"
.Size=10
.Strikethrough=False
.Superscript=False
.Subscript=False
.OutlineFont=False
.Shadow=False
.Underline=xlUnderlineStyleNone
.colorIndex=2
单元格设定边框
Selection.Borders(xlEdgeTop).LineStyle=xlNone
.colorIndex=56
Selection.Borders(xlInsideHorizontal).LineStyle=xlNone
WithSelection.Interior
.colorIndex=5
.Pattern=xlSolid
.PatternColorIndex=xlAutomatic
设定头两行的内部样式'
B1:
B2"
Selection.Merge
C1:
C2"
D1:
D2"
设置头两行行高为11.25
Selection.RowHeight=14.25
WithSelection.Font
加粗"
.Size=8
.WrapText=True
.colorIndex=HEADERCOLORINDEX
Type"
=4).Font
E1:
F1"
E2:
F2"
.MergeCells=False
加第一二行边框
WithSelection.Borders(xlInsideHorizontal)
去掉第三行的:
号
sTempString=Right(Cells(3,1),Len(Cells(3,1))-3)
ActiveCell.FormulaR1C1=sTempString
i=2
j=1
外层循环判断是否都合并完成,这里插入了一行,加1
Whilei<
=cRows
i=i+1
Range(Cells(i+1,j),Cells(i+1,j)).Select
去掉分类行中的:
If(Len(Cells(i+1,j))>
=3)Then
如果是分格的界限
If(Left(Cells(i+1,j),3)="
:
"
)Then
Range(Cells(i+1,j),Cells(i+1,cColumns)).Select
对第三行进行设定
Selection.RowHeight=18
合并前两格
先将其合并
.HorizontalAlignment=xlLeft'
靠左对齐
合并
对其设定字体风格
.Size=9
.colorIndex=3
.HorizontalAlignment=xlLeft
sTempString=Right(Cells(i+1,j),Len(Cells(i+1,j))-3)
ActiveCell.FormulaR1C1=sTempString
EndIf
加1后判断是否到了表尾,没有继续合并处理
If(i<
=cRows+1)Then
rowIndex=i
取出Cells(i,j)的内容
sTempString=Cells(i,j)
循环判断下一个单元格是否和上一个单元格相等,不是则表示到此该合并
WhilesTempString=Cells(i+1,j)Andi<
Wend
设置第一列'
跳出循环表示已经到此该将rowIndex和i行合并
Range(Cells(rowIndex,j),Cells(i,j)).Select
将原来内容填充进来
设合并后的单元格的边框
Selection.Font.FontStyle="
设置第一列结束'
设置第二列'
Range(Cells(rowIndex,j+1),Cells(i,j+1)).Select
设置字体
WithSelection.Borders(xlEdge
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel VBA编程实例 VBA 编程 实例
![提示](https://static.bdocx.com/images/bang_tan.gif)