Sub 导表() expath = ThisDocument.Path & "\" Set exapp = CreateObject("excel.application") exapp.Visible = True exapp.workbooks.Open (expath + "销量情况.xlsx") exapp.sheets("Sheet2").Select '城市数量 citys_Num = exapp.Application.CountA(exapp.Range("j:j")) For i = 2 To citys_Num CityName = exapp.Range("j" & i) miaoshu = exapp.Range("e21") '数据透视表索引 exapp.ActiveSheet.PivotTables("数据透视表1").PivotFields("客户省份").ClearAllFilters exapp.ActiveSheet.PivotTables("数据透视表1").PivotFields("客户省份").CurrentPage = CityName FileCopy expath + "模板.docx", expath + "地区文件\" + i & CityName + ".docx" '打开文档 Set doc = Documents.Open(expath + "地区文件\" + i & CityName + ".docx") '替换某某 With Selection.Find .Text = "某某" .Forward = True .Replacement.Text = CityName .Execute Replace:=wdReplaceAll End With With Selection.Find .Text = "某" .Forward = True .Replacement.Text = CityName .Execute Replace:=wdReplaceAll End With With Selection.Find .Text = "各地区销量排行前10名" .Forward = True .Execute End With Selection.MoveDown unit:=wdLine, Count:=1 '插入表格 Selection.Tables.Add Selection.Range, 11, 2 Selection.Tables(1).Style = "网格型" '搬运 n = 1 For j = 1 To 11 For k = 1 To 2 doc.Tables(1).Range.Cells(n) = exapp.Cells(j + 1, k + 4) n = n + 1 Next Next '图1 With Selection.Find .Text = "广西" .Forward = True .Execute End With Selection.MoveDown unit:=wdLine, Count:=2 exapp.ActiveSheet.ChartObjects("图表 1").Activate exapp.Activechart.ChartArea.Copy Selection.Paste '图2 With Selection.Find .Text = "地区产品销量排行前10名" .Forward = True .Execute End With Selection.MoveDown unit:=wdLine, Count:=1 exapp.ActiveSheet.ChartObjects("图表 4").Activate exapp.Activechart.ChartArea.Copy Selection.Paste With Selection.Find .Text = "综合描述：" .Forward = True .Replacement.Text = miaoshu .Execute Replace:=wdReplaceAll End With '图3 With Selection.Find .Text = "地区各产品销售量情况对比图" .Forward = True .Execute End With Selection.MoveDown unit:=wdLine, Count:=2 exapp.ActiveSheet.ChartObjects("图表 3").Activate exapp.Activechart.ChartArea.Copy Selection.Paste '词云 ' Debug.Print exapp.Application.counta(exapp.Range("j:j")) str1 = "" exapp.ActiveSheet.Shapes.Range(Array("TextBox 2")).Select exapp.Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = str1 For u = 4 To exapp.Application.CountA(exapp.Range("a:a")) - 2 + 4 str1 = str1 + exapp.Range("a" & u) + " " Next exapp.ActiveSheet.Shapes.Range(Array("TextBox 2")).Select exapp.Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = str1 L = 1 For v = 4 To exapp.Application.CountA(exapp.Range("a:a")) - 2 + 4 With exapp.Selection.Characters(L, Len(exapp.Range("a" & v))).Font .Size = exapp.Range("c" & v) .ColorIndex = exapp.Application.randbetween(1, 50) End With L = Len(exapp.Range("a" & v)) + 2 + L Next With Selection.Find .Text = "地区各产品销售额标签云图" .Forward = True .Execute End With Selection.MoveDown unit:=wdLine, Count:=1 ' exapp.ActiveDocument.Shapes.Range(Array("文本框 2")).Select ' doc.Selection.PasteAndFormat (wdFormatOriginalFormatting) 'exapp.ActiveSheet.ChartObjects("图表 3").Activate ' exapp.Activechart.ChartArea.Copy ' Selection.Paste exapp.ActiveSheet.Shapes.Range(Array("TextBox 2")).Select exapp.Selection.Copy Selection.Paste doc.Save doc.Close Next exapp.Save exapp.Quit End Sub