kerrypnx
7/12/2018 - 2:33 AM

word按26个字母开头分别导出为Excel-18-7-12

word按26个字母开头分别导出为Excel-18-7-12

Sub qwe1111()

 Dim app_excel As Excel.Application
 Dim book_excel As Excel.Workbook
 Dim str As String
 Dim i, j As Integer
 For j = 65 To 90
 For i = 97 To 122
 selection.HomeKey wdStory

With selection.Find
  .Text = ChrW(j) + ChrW(i) + "[!^13]@^13" + "[" + ChrW(j) + ChrW(i) + "]" + "[!" + ChrW(i) + "]"
  .MatchWildcards = True
  .Replacement.Text = ""
  .Wrap = wdFindStop
  .Forward = True
  .Execute
  If selection.Find.Found Then
  
  
          selection.MoveLeft wdCharacter, 1
          selection.Paragraphs(1).Range.Select
          
          Set aimrng = ActiveDocument.Range(ActiveDocument.Range.Start, selection.Paragraphs(1).Range.End)
          aimrng.Select
          selection.Cut
          Set app_excel = New Excel.Application                               '申请一个Excel.Application内存空间
          Set book_excel = app_excel.Workbooks.Add
          book_excel.SaveAs ("d:\abbbbbb\" + ChrW(j) + ChrW(i) + ".xlsx")
          book_excel.Sheets("sheet1").Paste
          book_excel.Close 1
       
    
 End If
    
End With
Next i
Next j
End Sub