SHARE
TWEET

search bold, italic, Courier New text etc. & insert HTML tag

tolikpunkoff Jan 29th, 2015 (edited) 270 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub InsertHTMLTags2()
  2. '
  3. ' Вставляет теги HTML
  4. '
  5. '
  6.    'Переход в начало документа
  7.    Selection.HomeKey Unit:=wdStory
  8.    
  9.     'Поиск того, что по центру
  10.    Selection.Find.ClearFormatting
  11.     With Selection.Find
  12.         .ParagraphFormat.Alignment = wdAlignParagraphCenter
  13.         .Text = ""
  14.         .Replacement.Text = ""
  15.         .Forward = True
  16.         .Wrap = wdFindContinue
  17.         .Format = True
  18.         .MatchCase = False
  19.         .MatchWholeWord = False
  20.         .MatchWildcards = False
  21.         .MatchSoundsLike = False
  22.         .MatchAllWordForms = False
  23.     End With
  24.     'Вставка соответствующих тегов
  25.    InsertTags "<center>", "</center>"
  26.     'Возврат в начало документа
  27.    Selection.HomeKey Unit:=wdStory
  28.    
  29.     'Поиск того, что выделено "Курьером"
  30.    Selection.Find.ClearFormatting
  31.     With Selection.Find
  32.         .Font.NameAscii = "Courier New"
  33.         .Text = ""
  34.         .Replacement.Text = ""
  35.         .Forward = True
  36.         .Wrap = wdFindContinue
  37.         .Format = True
  38.         .MatchCase = False
  39.         .MatchWholeWord = False
  40.         .MatchWildcards = False
  41.         .MatchSoundsLike = False
  42.         .MatchAllWordForms = False
  43.     End With
  44.     'Вставка соответствующих тегов
  45.    InsertTags "<code>", "</code>"
  46.     'Возврат в начало документа
  47.    Selection.HomeKey Unit:=wdStory
  48.    
  49.     'Поиск того, что выделено жирным
  50.    Selection.Find.ClearFormatting
  51.     With Selection.Find
  52.         .Font.Bold = True
  53.         .Text = ""
  54.         .Replacement.Text = ""
  55.         .Forward = True
  56.         .Wrap = wdFindContinue
  57.         .Format = True
  58.         .MatchCase = False
  59.         .MatchWholeWord = False
  60.         .MatchWildcards = False
  61.         .MatchSoundsLike = False
  62.         .MatchAllWordForms = False
  63.     End With
  64.     'Вставка соответствующих тегов
  65.    InsertTags "<b>", "</b>"
  66.     'Возврат в начало документа
  67.    Selection.HomeKey Unit:=wdStory
  68.    
  69.     'Поиск того, что выделено курсивом
  70.    Selection.Find.ClearFormatting
  71.     With Selection.Find
  72.         .Font.Italic = True
  73.         .Text = ""
  74.         .Replacement.Text = ""
  75.         .Forward = True
  76.         .Wrap = wdFindContinue
  77.         .Format = True
  78.         .MatchCase = False
  79.         .MatchWholeWord = False
  80.         .MatchWildcards = False
  81.         .MatchSoundsLike = False
  82.         .MatchAllWordForms = False
  83.     End With
  84.     'Вставка соответствующих тегов
  85.    InsertTags "<i>", "</i>"
  86.     'Возврат в начало документа
  87.    Selection.HomeKey Unit:=wdStory
  88.    
  89.     'Поиск того, что выделено зачеркнутым
  90.    Selection.Find.ClearFormatting
  91.     With Selection.Find
  92.         .Font.StrikeThrough = True
  93.         .Text = ""
  94.         .Replacement.Text = ""
  95.         .Forward = True
  96.         .Wrap = wdFindContinue
  97.         .Format = True
  98.         .MatchCase = False
  99.         .MatchWholeWord = False
  100.         .MatchWildcards = False
  101.         .MatchSoundsLike = False
  102.         .MatchAllWordForms = False
  103.     End With
  104.     'Вставка соответствующих тегов
  105.    InsertTags "<s>", "</s>"
  106.     'Возврат в начало документа
  107.    Selection.HomeKey Unit:=wdStory
  108.    
  109.     'Поиск того, что выделено надстрочным индексом
  110.    Selection.Find.ClearFormatting
  111.     With Selection.Find
  112.         .Font.Superscript = True
  113.         .Text = ""
  114.         .Replacement.Text = ""
  115.         .Forward = True
  116.         .Wrap = wdFindContinue
  117.         .Format = True
  118.         .MatchCase = False
  119.         .MatchWholeWord = False
  120.         .MatchWildcards = False
  121.         .MatchSoundsLike = False
  122.         .MatchAllWordForms = False
  123.     End With
  124.     'Вставка соответствующих тегов
  125.    InsertTags "<sup>", "</sup>"
  126.     'Возврат в начало документа
  127.    Selection.HomeKey Unit:=wdStory
  128.    
  129.     'Поиск того, что выделено подстрочным индексом
  130.    Selection.Find.ClearFormatting
  131.     With Selection.Find
  132.         .Font.Subscript = True
  133.         .Text = ""
  134.         .Replacement.Text = ""
  135.         .Forward = True
  136.         .Wrap = wdFindContinue
  137.         .Format = True
  138.         .MatchCase = False
  139.         .MatchWholeWord = False
  140.         .MatchWildcards = False
  141.         .MatchSoundsLike = False
  142.         .MatchAllWordForms = False
  143.     End With
  144.     'Вставка соответствующих тегов
  145.    InsertTags "<sub>", "</sub>"
  146.     'Возврат в начало документа
  147.    Selection.HomeKey Unit:=wdStory
  148.    
  149.     'Очистка условий поиска
  150.    Selection.Find.ClearFormatting
  151. End Sub
  152. Private Sub ShiftArr(ByRef arr As Variant, pos As Long, ctr As Long)
  153.     For I = 1 To ctr
  154.         For J = pos To UBound(arr) - 1
  155.             arr(J) = arr(J + 1)
  156.         Next J
  157.     Next I
  158. End Sub
  159. Private Sub InsertTags(OpenTag As String, CloseTag As String)
  160.     Dim Start_s() As Long
  161.     Dim End_s() As Long
  162.     Dim I As Long
  163.    
  164.     ctr = 0
  165.     shiftctr = 0
  166.     Selection.Find.Execute
  167.     If Not Selection.Find.Found Then Exit Sub
  168.     'Поиск необходимых интервалов
  169.    Do While Selection.Find.Found
  170.         ctr = ctr + 1
  171.         ReDim Preserve Start_s(ctr)
  172.         ReDim Preserve End_s(ctr)
  173.         Start_s(ctr) = Selection.Start
  174.         End_s(ctr) = Selection.End
  175.         Selection.Find.Execute
  176.     Loop
  177.    
  178.    
  179.     ' Удаление лишних интервалов (в которых конец текущего интервала совпадает с началом следующего)
  180.    For I = 1 To ctr - 1
  181.         Do While End_s(I) = Start_s(I + 1)
  182.             ShiftArr Start_s, I + 1, 1
  183.             ShiftArr End_s, I, 1
  184.             shiftctr = shiftctr + 1
  185.         Loop
  186.     Next I
  187.    
  188.     'Изменение размерности - удаление ненужных элементов
  189.    ReDim Preserve Start_s(UBound(Start_s) - shiftctr)
  190.     ReDim Preserve End_s(UBound(End_s) - shiftctr)
  191.    
  192.     'Вставка тегов
  193.    TagLen = Len(OpenTag) + Len(CloseTag)
  194.     AllTagLen = TagLen
  195.     For I = 1 To UBound(Start_s)
  196.         Selection.Start = Start_s(I)
  197.         Selection.End = End_s(I)
  198.         Selection.Text = OpenTag + Selection.Text + CloseTag
  199.         If I <> UBound(Start_s) Then
  200.             Start_s(I + 1) = Start_s(I + 1) + AllTagLen
  201.             End_s(I + 1) = End_s(I + 1) + AllTagLen
  202.             AllTagLen = AllTagLen + TagLen
  203.         End If
  204.     Next I
  205. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top