怎么用VBA实现这个功能

shuiliu000

请帮我一下，要处理大量同类型的练习题，我想做一个半自动的VBA功能来辅助

xyxcc177

思路挺好的

乐乐2006201505

看看是否是你想要的。
Sub AA提取红色字体数据代码()  '出处：http://www.dzwebs.net/2876.html
  'word中某颜色字代码出处：http://www.dzwebs.net/2876.html
'    Set docNew = Documents.Add
'    Set tblnew = docNew.Table.Add(slection.Range, 3, 5)
  Dim b() As Boolean, arr()
  单词数 = 3
  ReDim arr(单词数 - 1)
  ReDim b(单词数 - 1) '取数标志
  Dim x As Integer, y As Integer
  Randomize
  For i = 0 To 单词数 - 1
    Do '找到x的位置，y表示x在取数标志数组的位置
      x = Int(Rnd * (单词数 - 1 + 1)) + 1
      y = x - 1
    Loop While b(y)
    b(y) = True
    arr(i) = x '找到未取的数，并放入数组，设置标志位
  Next i

  With ActiveDocument
  Selection.HomeKey Unit:=wdStory
  Selection.MoveDown Unit:=wdLine, Count:=1 '将光标下移一行
  Selection.InsertAfter vbCr
  Set tblnew = .Tables.Add(Selection.Range, NumRows:=1, _
      NumColumns:=单词数)
    With Selection.Find
      .Parent.HomeKey Unit:=wdStory
      .ClearFormatting
      .Font.Color = wdColorRed
      Do While .Execute
        j = j + 1
        tblnew.Cell(1, arr(j - 1)) = .Parent
        a = Round((Len(.Parent) * 1.5), 0)
        Selection.Font.Underline = wdUnderlineSingle
        Selection.Font.UnderlineColor = -587137025
        Selection.TypeText Text:=Space(a)
      Loop
    End With
    With tblnew
      '设置外边框
      .Borders(wdBorderLeft).LineStyle = wdLineStyleThinThickMedGap
      .Borders(wdBorderLeft).LineWidth = wdLineWidth225pt
      .Borders(wdBorderRight).LineStyle = wdLineStyleThickThinMedGap
      .Borders(wdBorderRight).LineWidth = wdLineWidth225pt
      .Borders(wdBorderTop).LineStyle = wdLineStyleThinThickMedGap
      .Borders(wdBorderTop).LineWidth = wdLineWidth225pt
      .Borders(wdBorderBottom).LineStyle = wdLineStyleThickThinMedGap
      .Borders(wdBorderBottom).LineWidth = wdLineWidth225pt
      '设置内边框
      With .Borders
        .InsideLineStyle = wdLineStyleSingle
        .InsideLineWidth = wdLineWidth100pt
        .InsideColor = wdColorblank 'White
      End With
      '自动调整表格
      .Columns.PreferredWidthType = wdPreferredWidthAuto
      .AutoFitBehavior (wdAutoFitContent) '根据内容调整表格
'      .AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格
      With .Range
        With .Font '字体格式
          .Name = "宋体"
          .Name = "Times New Roman"
          .Color = wdColorAutomatic '自动字体颜色
          .Size = 12
          .Kerning = 0
          .DisableCharacterSpaceGrid = True
        End With
        With .ParagraphFormat '段落格式
          .CharacterUnitFirstLineIndent = 0 '取消首行缩进
          .FirstLineIndent = CentimetersToPoints(0) '取消首行缩进
          .LineSpacingRule = wdLineSpaceSingle '单倍行距  wdLineSpaceExactly '行距固定值
          '.LineSpacing = 20 '设置行间距为20磅，配合行距固定值
          .Alignment = wdAlignParagraphCenter '单元格水平居中
          .AutoAdjustRightIndent = False
          .DisableLineHeightGrid = True
        End With
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter  '单元格垂直居中
      End With
    End With
  End With
End Sub

shuiliu000

乐乐2006201505 发表于 2020-4-2 21:13
看看是否是你想要的。
Sub AA提取红色字体数据代码()  '出处：http://www.dzwebs.net/2876.html
  'word ...

谢谢，明天我测试下