vba词云简板

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