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
vba词云简板
猜你喜欢
转载自blog.csdn.net/Captain_DUDU/article/details/103359707
今日推荐
周排行