Sub 孤独一叶() '工具、引用,microsoft excel 11.0 object library '前提条件是表格格式统一,与你上传的一样。 Dim aexl As Excel.Application, axls As Excel.Workbook '定义excel程序 Dim acell As Cell, arang As Range, astr() As String, atal As Table Dim i%, a%, b%, ata%, c% ata = ActiveDocument.Tables.Count ReDim astr(6 * ata - 1) '定义一个数组,包含6乘与表格数的字符串
i = 0 '设i=0 For Each atal In ActiveDocument.Tables astr(i) = "EI" & Right(atal.Range.Cells(2), 6) 'MsgBox astr(i) i = i + 1 astr(i) = Right(atal.Range.Cells(4), 10) ' MsgBox astr(i) i = i + 1 astr(i) = Mid(atal.Range.Cells(7), 5, Len(atal.Range.Cells(7).Range) - 1) ' MsgBox astr(i) i = i + 1 astr(i) = Mid(atal.Range.Cells(13), 4, Len(atal.Range.Cells(13).Range) - 1) ' MsgBox astr(i) i = i + 1 astr(i) = Mid(atal.Range.Cells(15), 6, Len(atal.Range.Cells(15).Range) - 1) ' MsgBox astr(i) i = i + 1 astr(i) = Mid(atal.Range.Cells(17), 8, Len(atal.Range.Cells(17).Range) - 1) 'MsgBox astr(i) i = i + 1 Next '以下为控制excel部分 Set aexl = CreateObject("excel.application") With aexl .Visible = True Set axls = aexl.Workbooks.Add For b = 2 To ata + 1 For c = 1 To 6 axls.Sheets(1).Cells(b, c) = astr(a) '取得数 a = a + 1 '数组累加 Next Next End With ' axls.SaveAs FileName:="c:\孤.xls" '保存 ' axls.Close '关闭 'Set aexl = Nothing '释放变量 End Sub |