|
|
|
问题:
守柔,你好.
这是我这些天根据WORD VBA所做的一个宏,有些效果做不出来,特向你请教,详细见附件WORD VBA请教中的gongyi宏,不知能否指教与帮忙呢?
问题:除去列标题后,如何剩下的行的格式都为宋体,12号字,并且除了第3列是左对齐外,其余都是中间对齐.
还有,如何选择多列与多行呢?
另外,我觉得我这些代码很长,看到你所说的代码优化,我试着优化,却不成功.你再说说吗?
在此先多谢了.
此致
2005.9.8
原代码：
Sub gongyi()
Dim oDoc, oTable, iCount, oCell
Set oDoc = ActiveDocument
With oDoc.PageSetup
.LeftMargin = InchesToPoints(1) '左边距
.RightMargin = InchesToPoints(0.4) '右边距
.TopMargin = InchesToPoints(1) '上边距
.BottomMargin = InchesToPoints(0.4) '下边距
.FooterDistance = 0 '页眉
.HeaderDistance = 0 '页脚
End With
Set oTable = oDoc.Tables.Add(Range:=oDoc.Range(Start:=0, End:=0), NumRows:=20, NumColumns:=9)
'输入列标题
With oTable
' Row(1).Height = CentimetersToPoints(0.8)
.Cell(1, 1).Range.InsertAfter "序号"
.Cell(1, 2).Range.InsertAfter "工序"
.Cell(1, 3).Range.InsertAfter "工 艺 内 容"
.Cell(1, 4).Range.InsertAfter "每付件数"
.Cell(1, 5).Range.InsertAfter "每付工时"
.Cell(1, 6).Range.InsertAfter "送件日期"
.Cell(1, 7).Range.InsertAfter "操作人"
.Cell(1, 8).Range.InsertAfter "完成日期"
.Cell(1, 9).Range.InsertAfter "检验员"
End With
'设置整个表格的行高
With oTable
.Rows.HeightRule = wdRowHeightAtLeast
.Rows.Height = CentimetersToPoints(0.8)
End With
'选择整个表,并确定其字体,及字号
Selection.oDoc.Select
With Selection
.Font.Name = "宋体"
.Font.Size = 12
End With
'设置第1行的高度
With oTable.Rows(1)
.Height = CentimetersToPoints(1.2)
.HeightRule = wdRowHeightAtLeast
End With
'设置列宽
oTable.Columns(1).Width = CentimetersToPoints(0.8)
oTable.Columns(2).Width = CentimetersToPoints(1.5)
oTable.Columns(3).Width = CentimetersToPoints(8)
oTable.Columns(4).Width = CentimetersToPoints(1.2)
oTable.Columns(5).Width = CentimetersToPoints(1.2)
oTable.Columns(6).Width = CentimetersToPoints(1.2)
oTable.Columns(7).Width = CentimetersToPoints(1.5)
oTable.Columns(8).Width = CentimetersToPoints(1.2)
oTable.Columns(9).Width = CentimetersToPoints(1.5)
'设置首行的字体字号
Selection.SelectRow
Selection.Font.Name = "宋体"
Selection.Font.Size = 10.5
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
With oTable
.Cell(2, 1).Range.InsertAfter "1"
.Cell(2, 2).Range.InsertAfter "备料"
.Cell(2, 3).Range.InsertAfter "φ × "
.Cell(3, 1).Range.InsertAfter "2"
.Cell(3, 2).Range.InsertAfter "车"
.Cell(3, 3).Range.InsertAfter "精车达图"
.Cell(4, 3).Range.InsertAfter "端面平整、对角"
End With
End Sub
'----------------------
我修改后的代码:
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-9-9 6:01:03
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 0009^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub gongyi()
Dim oDoc As Document, oTable As Table
Dim i As Integer, myString As Variant, myColumn As Variant
Application.ScreenUpdating = False '关闭屏幕更新以加快运行速度
Set oDoc = ActiveDocument
With oDoc.PageSetup
.LeftMargin = InchesToPoints(1) '左边距
.RightMargin = InchesToPoints(0.4) '右边距
.TopMargin = InchesToPoints(1) '上边距
.BottomMargin = InchesToPoints(0.4) '下边距
.FooterDistance = 0 '页眉
.HeaderDistance = 0 '页脚
End With
Set oTable = oDoc.Tables.Add(Range:=oDoc.Range(Start:=0, End:=0), NumRows:=20, NumColumns:=9)
'输入列标题
With oTable
.Style = "网格型"
'单元格文本数组
myString = Array("序号", "工序", "工 艺 内 容", "每付件数", "每付工时", "送件日期", "操作人", "完成日期", "检验员")
'各列宽数组
myColumn = Array(0.8, 1.5, 8, 1.2, 1.2, 1.2, 1.5, 1.2, 1.5)
For i = 1 To 9
'利用数组为表格列宽赋值
.Columns(i).Width = CentimetersToPoints(myColumn(i - 1))
'为单元格赋值,利用数组和循环可以简化代码
.Cell(1, i).Range = myString(i - 1)
Next
'设置整个表格的行高
.Rows.HeightRule = wdRowHeightAtLeast
.Rows.Height = CentimetersToPoints(0.8)
'表格字体与字体大小
.Range.Font.Name = "宋体"
.Range.Font.Size = 12
'设置第1行的高度
With .Rows(1)
.Height = CentimetersToPoints(1.2)
.HeightRule = wdRowHeightAtLeast
.Range.Font.Size = 10.5
End With
'设置列宽
'单元格文本
.Cell(2, 1).Range = "1"
.Cell(2, 2).Range = "备料"
.Cell(2, 3).Range = "φ × "
.Cell(3, 1).Range = "2"
.Cell(3, 2).Range = "车"
.Cell(3, 3).Range = "精车达图"
.Cell(4, 3).Range = "端面平整、对角"
'所有单元格先设置为中部居中
.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Columns(3).Select '第三列为左对齐
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
'---------------------- |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-9-9 06:02
发表于 2005-9-9 08:02
