iteye bbcode编辑器快速排版技巧 -欧洲杯足彩官网

 sub 自动链接()
'识别链接，提取url，在链接文本前后加上[url]标记
for each ahyperlink in activedocument.hyperlinks        
   if instr(lcase(ahyperlink.address), "http") <> 0 then        
      ahyperlink.range.select
         
    with selection
      .insertbefore "[url=" & ahyperlink.address & "]"
    end with
           
    with selection
      .insertafter "[/url]"
    end with
    
    end if
        
next ahyperlink
end sub
sub 清除格式()
   selection.clearformatting
       
end sub
sub 添加行号()
'在选中的每个段落前加上1. 2. 3.……
dim parag as paragraph
dim nlinenum: nlinenum = 0
dim selrge as range
set selrge = selection.range
  
  for each parag in selection.paragraphs
  nlinenum = nlinenum   1
  
  
if nlinenum > 0 then
   selrge.paragraphs(nlinenum).range.insertbefore (nlinenum & ".  ")
 
 end if
  
  
'个位数前自动添加0
' if nlinenum < 10 and nlinenum > 0 then
'    selrge.paragraphs(nlinenum).range.insertbefore ("0" & nlinenum & "   ")
'  else
'    selrge.paragraphs(nlinenum).range.insertbefore (nlinenum & "   ")
'  end if
  
 next
end sub
sub 表格转换()
'将表格转换成bbcode表格格式
换表格
每段加竖线
首尾加table
end sub
sub 换表格()
' 将文本换为表格
    selection.rows.converttotext separator:=wdseparatebydefaultlistseparator, _
        nestedtables:=true
end sub
sub 首尾加table()
'选择区域首位加上[ table]、[ /table]
with selection
    .insertparagraphbefore
end with
  
with selection
    .insertbefore "[ table]"
end with
with selection
    .insertafter "[ /table]"
end with
end sub
sub 每段加竖线()
'选择区域所有段落前加|
dim parag as paragraph
dim nlinenum: nlinenum = 0
dim selrge as range
set selrge = selection.range
  
  for each parag in selection.paragraphs
  
 
  nlinenum = nlinenum   1
  
  
  if nlinenum > 0 then
  
    selrge.paragraphs(nlinenum).range.insertbefore ("|")
        
    set myrange = selrge.paragraphs(nlinenum).range
        
    myrange.end = myrange.end - 1
    
    myrange.insertafter ("|")
  end if
  
 next
end sub
sub 图片居中()
' 在所有[img][/img]标记前后加上[align=center][/align]
    selection.homekey unit:=wdstory
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "[img]"
        .replacement.text = "[align=center][img]"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    selection.homekey unit:=wdstory
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "[/img]"
        .replacement.text = "[/img][/align]"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 删除空白行()
'删除空行
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p^p"
        .replacement.text = "^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 段首加空格()
'在每段段首加上4个半角空格
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p"
        .replacement.text = "^p    "
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = false
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 段首删空格()
'删除每段段首的空格
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p "
        .replacement.text = "^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = false
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 删图()
'删除word文档中的所有图片
dim pic as inlineshape 
 for each pic in activedocument.inlineshapes 
 if pic.width <> 0 then
pic.select 
 selection.delete 
 end if
next
end sub
sub 手动换行()
'将所有段落标记替换为手动换行标记
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p"
        .replacement.text = "^l"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 自动换行()
'将所有手动换行标记替换为段落标记
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^l"
        .replacement.text = "^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 换html空格()
' 将所有html格式空格替换为半角空格
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = " "
        .replacement.text = " "
        .forward = true
        .wrap = wdfindask
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    
       
end sub
sub 自动缩放图()
'将word文档中的可见图片调整为统一大小
dim myis as inlineshape
for each myis in activedocument.inlineshapes
    
  if myis.width > centimeterstopoints(2.5) then
  
      
   if myis.width < centimeterstopoints(0.5) then goto 10
   if myis.height < centimeterstopoints(0.5) then goto 10
     
     myis.reset
     
    ' myis.pictureformat.colortype = msopicturegrayscale
     myis.lockaspectratio = msotrue
     
    
    myis.scalewidth = 70
    
    if myis.width > centimeterstopoints(5) then myis.width = centimeterstopoints(9)
    
    myis.scaleheight = myis.scalewidth
         
      
  end if
10: next myis
end sub
sub 图居中()
'居中word文档中的所有可见图片
dim myis as inlineshape
for each myis in activedocument.inlineshapes
    
  if myis.width > 0 then
  
  myis.select
  
  
  selection.paragraphformat.alignment = wdalignparagraphcenter
      
        
  end if
next myis
end sub
sub 换全角空格()
' 将所有全角空格替换为半角空格
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "　"
        .replacement.text = " "
        .forward = true
        .wrap = wdfindask
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 换空格()
 
  换html空格
  换全角空格
end sub
sub 加粗()
'在选中的文字前后加上[b][/b]
  
with selection
    .insertbefore "[b]"
end with
with selection
    .insertafter "[/b]"
end with
end sub
sub 加链接()
  
  
with selection
    .insertbefore "[url]"
end with
with selection
    .insertafter "[/url]"
end with
end sub
sub 加链接2()
  
  
with selection
    .insertbefore "[url=]"
end with
with selection
    .insertafter "[/url]"
end with
end sub
sub 列表标签()
'选择区域首位加上[list][/list]
with selection
    .insertparagraphbefore
end with
  
with selection
    .insertbefore "[list]"
end with
with selection
    .insertafter "[/list]"
end with
end sub
sub 列表段号()
'选择区域所有段落前加[*]
dim parag as paragraph
dim nlinenum: nlinenum = 0
dim selrge as range
set selrge = selection.range
  
  for each parag in selection.paragraphs
  nlinenum = nlinenum   1
  
  if nlinenum > 0 then
    selrge.paragraphs(nlinenum).range.insertbefore ("[*]")
  end if
  
 next
end sub
sub 加列表()
列表段号
列表标签
end sub
sub 去底纹()
    selection.wholestory
    
    去段落底纹
    去文字底纹
    
end sub
sub 去文字底纹()
    
    
    with selection.font
        with .shading
            .texture = wdtexturenone
            .foregroundpatterncolor = wdcolorautomatic
            .backgroundpatterncolor = wdcolorautomatic
        end with
        .borders(1).linestyle = wdlinestylenone
        .borders.shadow = false
    end with
    with options
        .defaultborderlinestyle = wdlinestylesingle
        .defaultborderlinewidth = wdlinewidth050pt
        .defaultbordercolor = wdcolorautomatic
    end with
end sub
sub 去段落底纹()
  
    with selection.paragraphformat
        with .shading
            .texture = wdtexturenone
            .foregroundpatterncolor = wdcolorautomatic
            .backgroundpatterncolor = wdcolorautomatic
        end with
        .borders(wdborderleft).linestyle = wdlinestylenone
        .borders(wdborderright).linestyle = wdlinestylenone
        .borders(wdbordertop).linestyle = wdlinestylenone
        .borders(wdborderbottom).linestyle = wdlinestylenone
        .borders(wdborderhorizontal).linestyle = wdlinestylenone
        with .borders
            .distancefromtop = 1
            .distancefromleft = 4
            .distancefrombottom = 1
            .distancefromright = 4
            .shadow = false
        end with
    end with
    with options
        .defaultborderlinestyle = wdlinestylesingle
        .defaultborderlinewidth = wdlinewidth050pt
        .defaultbordercolor = wdcolorautomatic
    end with
end sub
sub 标题样式加粗()
'如果段落样式为指定样式，则在首位加上[b][/b]
dim cuti as paragraph
 
  for each cuti in activedocument.paragraphs
  
  if cuti.style = activedocument.styles("标题 3") then
  
  cuti.range.select
  
  with selection
      .insertbefore "[b]"
    end with
           
    with selection
      .insertafter "[/b]"
    end with
  end if
  
 next
end sub
sub 标题长度加粗()
' 要求用户设置长度值
dim message, title, default, myvalue
message = "请输入限定的段落文本字/单词数"
title = "限定长度"
default = "10"
myvalue = inputbox(message, title, default)
' 如果段落文字长度小于设定值，则在首位加上[b][/b]
dim cuti as paragraph
 
  for each cuti in activedocument.paragraphs
  
      
  if cuti.range.words.count < myvalue and cuti.range.words.count > 1 then
  
  
'  range.characters.count < 20 then
       
  cuti.range.select
     
  with selection
      .insertbefore "[b]"
    end with
        
   selection.endkey unit:=wdline
   selection.typetext text:="[/b]"
   selection.moveright unit:=wdcharacter, count:=1
      
    
   ' with selection
   '   .insertafter "[/b]"
  '  end with
  end if
   
 next
end sub
sub 清除加粗()
' 清除所有的加粗标记[b][/b]
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "[b]"
        .replacement.text = ""
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    with selection.find
        .text = "[/b]"
        .replacement.text = ""
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 修复分段()
'
' 文中有不正确的分段标记，该宏可以修复此类问题
'
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p"
        .replacement.text = "aaabbbccc"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    with selection.find
        .text = ".aaabbbccc"
        .replacement.text = ".^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    with selection.find
        .text = "aaabbbccc"
        .replacement.text = "   "
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 删空行()
dim kong as paragraph
 
  for each kong in activedocument.paragraphs
  
      
  if kong.range.characters.count = 1 then
  
         
  kong.range.select
  
  selection.delete
       
  
  end if
   
 next
段首删空格
end sub
sub 检查链接()
'
' 检查“[url=”和“http://”中是否有空格，有则删除
'
'
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "[url= http://"
        .replacement.text = "[url=http://"
        .forward = true
        .wrap = wdfindask
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
   
    with selection.find
        .text = "[url= https://"
        .replacement.text = "[url=https://"
        .forward = true
        .wrap = wdfindask
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    
end sub
sub 取消所有超链接()
'清除所有的超链接
dim ofield as field
for each ofield in activedocument.fields
 if ofield.type = wdfieldhyperlink then
   ofield.unlink
 end if
   
next
   set ofield = nothing
end sub
sub 选择部分手动换行()
'将选择部分的段落标记替换为手动换行标记
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p"
        .replacement.text = "^l"
        .forward = true
        .wrap = wdfindask
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub
sub 周报链接()
'markup语法（写周报用）：识别链接，提取url，加上#
for each ahyperlink in activedocument.hyperlinks
        
   if instr(lcase(ahyperlink.address), "http") <> 0 then
        
      ahyperlink.range.select
         
    with selection
      .insertbefore "#[" & ahyperlink.address & " "
    end with
           
    with selection
      .insertafter "]"
    end with
    
    end if
        
next ahyperlink
end sub
sub 超级替换()
'把常见的确实可以自动替换的错别字进行自动替换。
'第一个参数是错别字，第二个参数是正确的字
替换常用错别字 "惟一", "唯一"
替换常用错别字 "帐号", "账号"
替换常用错别字 "图象", "图像"
替换常用错别字 "登陆", "登录"
替换常用错别字 "其它", "其他"
替换常用错别字 "按装", "安装"
替换常用错别字 "按纽", "按钮"
替换常用错别字 "成份", "成分"
替换常用错别字 "题纲", "提纲"
替换常用错别字 "煤体", "媒体"
替换常用错别字 "存贮", "存储"
替换常用错别字 "一桢", "一帧"
替换常用错别字 "好象", "好像"
替换常用错别字 "对像", "对象"
end sub
sub 替换常用错别字(strwrong as string, strright)
'此过程仅供程序调用，不要人手工使用
'
'
'
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = strwrong
        .replacement.text = strright
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
end sub

sub 段间加空行()
'在段落间加上空行，[list]列表之间不加空行
    selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p"
        .replacement.text = "^p^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
    
    
     selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "^p[*]"
        .replacement.text = "[*]"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
   
     
     selection.find.clearformatting
    selection.find.replacement.clearformatting
    with selection.find
        .text = "[/list]^p^p"
        .replacement.text = "[/list]^p"
        .forward = true
        .wrap = wdfindcontinue
        .format = false
        .matchcase = false
        .matchwholeword = false
        .matchbyte = true
        .matchwildcards = false
        .matchsoundslike = false
        .matchallwordforms = false
    end with
    selection.find.execute replace:=wdreplaceall
   
    
end sub
sub 字体红色()
  
with selection
    .insertbefore "[color=red]"
end with
with selection
    .insertafter "[/color]"
end with
end sub