注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

Mr.Right

不顾一切的去想,于是我们有了梦想。脚踏实地的去做,于是梦想成了现实。

 
 
 

日志

 
 
关于我

人生一年又一年,只要每年都有所积累,有所成长,都有那么一次自己认为满意的花开时刻就好。即使一时不顺,也要敞开胸怀。生命的荣枯并不是简单的重复,一时的得失不是成败的尺度。花开不是荣耀,而是一个美丽的结束,花谢也不是耻辱,而是一个低调的开始。

网易考拉推荐

阿英的word VBA处理表格和自定义样式札记  

2015-10-27 22:02:48|  分类: 编程 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
Sub applyStyle()
' "标题 2" 可以是自定义的样式名称
ActiveDocument.Paragraphs(1).Range.Style = ActiveDocument.Styles("标题 2")
End Sub


Sub changeStyle()


'1 将“标题 1”样式应用于所选内容的第一段
ActiveDocument.Paragraphs(1).Style = wdStyleHeading1

'2 下例将常用样式应用于活动文档的前四段
Set myRange = ActiveDocument.Range( _
Start:=ActiveDocument.Paragraphs(1).Range.Start, _
End:=ActiveDocument.Paragraphs(4).Range.End)
myRange.Style = wdStyleNormal

'3 定义一个新样式 myCaption
Set myStyle = ActiveDocument.Styles.Add(Name:="myCaption", _
Type:=wdStyleTypeCharacter)
myStyle.Font.Name = "Times New Roman"
myStyle.Font.NameFarEast = "宋体"
myStyle.Font.NameAscii = "Times New Roman"
myStyle.Font.NameOther = "Times New Roman"

myStyle.Font.Bold = False
myStyle.Font.Size = 12


' 3 更改"题注"的样式
Dim oPara As Paragraph
For Each oPara In ActiveDocument.Paragraphs
  If oPara.Range.Style = "题注" Then  ' 统一删除“题注”样式下的所有实例
' oPara.Range.Delete
 oPara.Range.Style = "myCaption"
  End If
Next



' 用 UpdateStyles方法更新活动文档中的样式
ActiveDocument.UpdateStyles

End Sub

'  ------------------------------------------------------------------------

Sub changeCaptionType()
    Dim oField As Field
    Dim sCode As String
    Dim TypeFind As String
    Dim TypeReplace As String
    Dim bFoundOne As String
    
    
    bFoundOne = 0
    
    'Swap strings around as required
    TypeReplace = "表"
    TypeFind = "图"
    ' = "Equation"
    
    '-- Change Field Code --
    For Each oField In ActiveDocument.Fields
      If oField.Type = wdFieldSequence Then
          sCode = oField.Code
          'MsgBox sCode
           If InStr(sCode, TypeFind) <> 0 Then
              bFoundOne = bFoundOne + 1 'counting how many
              oField.Code.Text = Replace(sCode, TypeFind, TypeReplace)
               'MsgBox oField.Code.Text
          End If
      End If
    Next
    
    '-- Change preceding text --
    With Selection.Find
      .Style = ActiveDocument.Styles("题注")
      .Text = TypeFind
      .Replacement.Text = TypeReplace
      .Forward = True
      .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    MsgBox ("Changed: " & bFoundOne) 'show how many when finished
End Sub

'  ------------------------------------------------------------------------
Sub processTable()
' 1) create table
Dim mRange As Range
Set mRange = ActiveDocument.Range
mRange.SetRange Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End
Set SelfGenTable = ActiveDocument.Tables.Add(Range:=mRange, NumRows:=4, NumColumns:=3)
' 2) modify border
For Each objTable In ActiveDocument.Tables
With objTable
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleNone
  ' .LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleNone
 '  .LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleDouble
.LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleDouble
.LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderHorizontal)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleNone
  ' .LineWidth = wdLineWidth075pt
End With
  ' .Borders.InsideLineStyle = wdLineStyleNone
End With
' 3) read and write table
objTable.Cell(Row:=1, Column:=1).Range.InsertAfter "项目"

' 4) modify alignment
objTable.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next objTable
End Sub



Sub Tester()


    Dim x, w, c

    ThisDocument.Tables(1).Delete

    ThisDocument.Tables.Add Range:=Selection.Range, NumRows:=7, NumColumns:=1, _
                          DefaultTableBehavior:=wdWord9TableBehavior, _
                          AutoFitBehavior:=wdAutoFitFixed

    With ThisDocument.Tables(1)

        .Rows.Height = 70
        w = .Rows(1).Cells(1).Width

        .Rows(1).Cells(1).Split 1, 7
        .Rows(1).Cells(1).Width = w / 2
        For x = 2 To 7
            .Rows(1).Cells(x).Width = (w / 2) / 6
        Next x

        .Rows(5).Height = 15
        .Rows(7).Height = 15

        .Rows(7).Cells(1).Split 1, 7

        .Rows(6).Cells(1).Split 1, 4
        .Rows(6).Cells(2).Split 2, 1

        'Once you merge cells it gets difficult to use .Rows, but
        '  you can still address individual cells. Use the loop below to
        '  find out which one you need to operate on...
        x = 1
        For Each c In .Range.Cells
            c.Range.Text = x
            x = x + 1
        Next c

        .Range.Cells(16).Split 1, 4
        'you can figure out setting the exact required widths...
    End With
    
    
    For Each atable In ActiveDocument.Tables
        atable.Borders.OutsideLineStyle = wdLineStyleSingle
        atable.Borders.OutsideLineWidth = wdLineWidth025pt
        atable.Borders.InsideLineStyle = wdLineStyleSingle ' wdLineStyleNone
    Next atable

End Sub
  评论这张
 
阅读(204)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2016