偶尔兴致来了，练习一些图表，记录一下

493861364

morpheus126 发表于 2022-8-7 10:41
非技术人员的话，有兴趣玩玩可以，真用到工作汇报经营分析的话，太卷了，整那么漂亮简直对不起自己劳动力 ...

哈，学的越多，越要慎用

493861364

往前翻了几页，应该没重，离600页越来越近了

wb_1027

画了一个寂寞

493861364

wb_1027 发表于 2022-8-11 19:47
画了一个寂寞

画了个例子（栗子）

493861364

太水了，每个柱子都有标签，纯柱形图

楼主赶紧发表大作啊，哈哈！

wb_1027

假设有图片所示的数据

要求展示各部门预算与实际费用使用情况
展示出超支或节约



利用 函数计算出超支与节约的差值，分两列
建立一个双折线图表
插入涨跌柱，美化即可

micch

每个形状指定同一个宏即可

1. Dim sp0 As Shape
   
2. '---形状点击执行的宏
   
3. Sub TestClick()
   
4.     s0$ = Application.Caller
   
5.     '---显示点击形状对应地名和形状设置颜色的宏（公共变量对前一个点击的形状恢复颜色）
   
6.     Range("F3").Value = s0
   
7.     If Not sp0 Is Nothing Then sp0.Fill.ForeColor.RGB = &HCCFFF2
   
8.     Set sp0 = Shapes(s0)
   
9.     '---B列地名，C列数据并设置地名对应的颜色
   
10.     Set Rng = Range("C" & Application.WorksheetFunction.Match(s0, Columns(2), 0))
    
11.     sp0.Fill.ForeColor.RGB = Rng.Interior.Color
    
12. End Sub
    
13. 
    

复制代码

493861364

micch 发表于 2022-8-22 10:58
每个形状指定同一个宏即可

厉害！！！                     

micch

[url=【地图显示信息】 https://www.bilibili.com/video/B ... 6bae3be1b5babc77410]北京地图，点击着色+显示信息[/url]

加个文本框显示一些数据，再加个api就可以做成鼠标滑过显示信息了，不过太麻烦，效果又没网页版好。
现在WPS支持JS，echart的图表效果要比这种做法舒服的多

micch

用形状比用图表要省事，计算一下各个数据和最大值的比例，设置圆的大小，然后对齐居中即可

1. Sub Main()
   
2.     Application.Calculation = xlCalculationManual
   
3.     With Sheet1
   
4.         .Calculate
   
5.         ar = .Range("b2:g7").Value
   
6.         t = .Shapes("Leval1").Top
   
7.         h = .Shapes("Leval1").Height
   
8.         For i = 3 To 6
   
9.             b = ar(i, 6)
   
10.             h0 = h * b
    
11.             .Shapes(i - 1).Height = h0
    
12.             .Shapes(i - 1).Width = h0
    
13.             .Shapes(i - 1).Top = t + h - h0
    
14.         Next
    
15.         With .Shapes.Range(Array("Leval1", "Leval2", "Leval3", "Leval4", "Leval5"))
    
16.             .Align msoAlignCenters, msoFalse
    
17.             .Align msoAlignBottoms, msoFalse
    
18.             .IncrementTop Sheet1.Range("J3").Top - Sheet1.Shapes("Leval1").Top
    
19.             .IncrementLeft Sheet1.Range("J3").Left - Sheet1.Shapes("Leval1").Left
    
20.         End With
    
21.     End With
    
22.     Application.Calculation = xlCalculationAutomatic
    
23. End Sub
    

复制代码