[第112期]变动的四象限图[开总结]

悠悠的炊烟

最近逛论坛新学习了几个有趣的知识点，出一题与大家分享同乐。
-------------------------------------------------------------------------------------------------------------------------------

下列数据源为橘子公司四大销售区域在2014年四个季度的销售收入，据此做如图片所示的四象限图，要求：

1. 在情景1：光标分别置于单元格A6，A7，A8，A9上但无需选中单元格时，或

   在情景2：光标分别选中单元格A6，A7，A8，A9或其所在行单元格时，

   在相应的象限显示该区域的销售收入饼图，饼图由其在2014年四个季度的数据组成；

2.  B6:E9的数据改变后，饼图应随着变化，所有数据标签随之变化；

3.四象限图为一张图表；

4.方法不限，但请叙述做图要点以便于批改。

得分：

情景1时符合题目要求的建议2个技术，情景2时符合题目要求的建议1个技术。得分不累加，取得分高者。

说明：

动画是为情景1录制的，新增的情景2场景类同，忽略动画最后的红字说明即可。

wudixin96

两个箭头也是图表元素？？还是另外插入的？？

说明：
1、图表是手工做的，箭头和东北两个文本框是手工插入的。
2、设置了三个名称，用于图表中数据源。
3、情景1，用了getcusorpos  API获取鼠标位置，再利用RangeFromPoint判断是不是在指定单元格区域。
     利用循环方式定时捕获鼠标位置，这个方法不太好，将就用下，觉得还是利用API实现好一点点。
     经测试，RangeFromPoint在64位Office下调用时，会出现溢出错误。
4、情景2，直接利用SelectionChange事件来判断 指定区域。
5、根据判断的单元格区域，来移动图表中的绘图区位置即可。

zmnyu

目前只完成了情景2，不知是否符合要求，详见附件，老师辛苦了。

蜗牛151

作图步奏已写，不过需要按F9才能自动刷新。望老师给解决方法，谢谢！

apirl2008

感觉这一期的图表题，简直就是给VBA定做的嘛，像我这种VBA白来说，想要做出那效果，真真的不容易呢
如果使用VBA来调整饼图在图表区中的位置，对于VBA大神来说，很简单，但我不会，只能另想办法来做了
以上均为废话，下面说一下小白的做法
－－－－－－－－－－－－－－－－－－－－－－－－－－－
1、分别插入四个柱子，像下面那样，为了以后变化时比较美观，不至于饼图变形，所以设置柱子的高度为100

分别将两个柱子设置为次坐标（至于是哪两个柱子，随你高兴了）
设置次坐标轴最大值为200，逆序
设置主坐标轴最大值为200
就会变成这样了

下面嘛，就是删除坐标轴，删除网格线
对柱子添加数据标签，标签修改为＝F13单元格，＝F14，＝F15，＝F16，调整标签所在位置
这个只不过是将四个区划分出来而已
下面，做辅助数据，添加表单控件，
辅助数据公式如下：=IF($G$6=ROW(A1),B6,"")
辅助数据效果如下

利用辅助数据再分别对东北，东南，西南，西北系列做四个饼图

分别添加数据标签，设置字体，大小，颜色
基础事情完成，下面就是使用饼图来填充柱子，这个，还想要数据变化，图表也跟着变化，只能使用到VBA了，代码如下：

1. Sub 宏1()
   
2.     ActiveSheet.ChartObjects("图表 7").Activate
   
3.     ActiveChart.CopyPicture
   
4.     ActiveSheet.ChartObjects("图表 6").Activate
   
5.     ActiveChart.SeriesCollection(3).Paste
   
6.     ActiveSheet.ChartObjects("图表 33").Activate
   
7.     ActiveChart.CopyPicture
   
8.     ActiveSheet.ChartObjects("图表 6").Activate
   
9.     ActiveChart.SeriesCollection(1).Paste
   
10.     ActiveSheet.ChartObjects("图表 34").Activate
    
11.     ActiveChart.CopyPicture
    
12.     ActiveSheet.ChartObjects("图表 6").Activate
    
13.     ActiveChart.SeriesCollection(2).Paste
    
14.     ActiveSheet.ChartObjects("图表 35").Activate
    
15.     ActiveChart.CopyPicture
    
16.     ActiveSheet.ChartObjects("图表 6").Activate
    
17.     ActiveChart.SeriesCollection(4).Paste
    
18. End Sub

复制代码

我那个哭中，小白不懂VBA，只能使用录宏的办法了
最后一步，添加系列5，设置为散点图，数据分别为：X轴：0，Y轴：100
对散点图添加误差线（这里比较纠结的就是误差线的键头，没办法，我使用了形状加上去的，加上文本分别为：北，东）
最终效果图如下：

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
到最后，纯粹是自娱自乐了，因为与题目中要求，点击单元格，图表发生变化不符，点击单元格，得使用到事件，还得用VBA，写不出来，退而求其次，使用了控件来达到类似效果

sevenstar

用VBA做的：
1.情景1：用API获取光标位置，得到光标所在单元格后调用画图过程
   情景2：比较简单，直接用SelectionChange事件得到单元格，然后画图
2.不会做四象限图，表中的两个轴是用另一个散点图的图片填充的，辅助数据在X~Z列
3.剩下的就简单了，用代码移动图表的绘图区到相应的象限即可
用2010版做的，手头没有2003，没有试

pxiceplay

说明：
制作饼图，按照图例预设好标签、颜色等格式，调整好图表区域和绘图区域大小，插入一个小计数量文本框、横竖两个作为坐标轴的箭头线，“东”、“北”两个文本框。
使用VBA实现情景（之前没想到1的方法，先做的2，现在两个并存）。
情景1：在A6:A9上覆盖了一个图像类型的activex控件，设置为透明无边框，利用控件的mousemove事件判断鼠标位置，并返回所在行数，调用moveplot子程序。
情景2：使用sheet的selectionchange事件判断所选单元格是否处于A6:F9区域，若在区域内则返回对应行数，调用moveplot子程序。（由于情景1的控件遮住了A6:A9区域，所以无法直接用鼠标选中，不知道算不算BUG）
moveplot子程序判定行数是否有变化，没变化不移动饼图和小计文本框位置，有变化则根据行数移动到对应象限的预定位置（此判定主要为了防止情景1中鼠标移动导致图表不停刷新，提升效率）。

gufengaoyue

试一下，不知道是不是符合要求。

cleverzhzhf

步骤：
1、选择A5:E6数据做饼图，设置字体为白色，背景颜色无填充，删除图例、标题等美化
2、B12设置为1、B13设置为1，以B12:B13做散点图1，设置坐标轴、背景色
3、B14设置为=F6、B15设置为0.4、B16设置为0.4，以B14:B16做散点图2，设置标签显示为“系列名称”
4、通过录制宏，完成代码，代码过程内容如下：
    1）修改B12:B16的数据，以符合方位；
    2）修改饼图所选择的数据区域；
    3）复制饼图，选择性粘贴为图片，复制图片，选择散点图1的点，Ctrl+V粘贴

悠悠的炊烟

前些日子逛EH论坛学到两个有趣的知识点，就想到把它们应用起来，加深印象：
1. 知识点1：
函数Hyperlink的一个神奇用法：当光标置于包含该函数的单元格上时能自动触发程序运行
2. 知识点2：
chartobjects的Copypicture方法

看了大家的答题后，不得不佩服大家无边的想象力：
从图表角度：
想象力1：
手工做一张饼图，缩小绘图区，在图表区内调整绘图区的位置来实现饼图在四象限的位置变化；
想象力2：
手工做了一张散点或柱形图，辅助做对应四个区域的饼图，用VBA复制饼图为图片，然后粘贴到相应的散点或柱子上；
想象力3：
方法1：手工做一张散点图+一张饼图，通过移动饼图实现其在四象限的位置变化；
方法2：手工做一张散点图+四张饼图，通过显示和隐藏饼图实现其在四象限的位置变化；
实现上述想象、获取鼠标位置当然离不开VBA。

出这道图表题本希望通过函数、VBA这两个图表的翼下之风，给图表插上想象的翅膀飞起来，怎奈真的让你们这些大V做成了VBA题，我这个汗呀。。。

之所以喜欢图表也是因为它给我们无限的想象空间，不同的构思决定不同的解决方案，不拘一格，为达到效果“不择手段”。

在此分享一下我的做法
一、构思
1. 手工做一张四象限散点图；
2. 想办法获得鼠标所在的单元格位置；
3. 另做一张饼图，数据取鼠标所在单元格对应的Q1~Q4的数据，复制饼图为图片到剪贴板，然后从剪贴板粘贴到散点上

二、具体实施
情景1
用到知识点：
1. 图表：散点图
2. 函数：Hyperlink
2. VBA
1）自定义函数
2）对象chartobjects的方法Copypicture

做图概要：
1. 手工做散点图，以四个散点表现四个区域，要点如下：                                           -- 此步同时适用于情景2
1）分别固定X、Y轴的最小值为-1，分别固定X、Y轴的最大值为1；
2）四个散点的坐标分别为(+/-0.5,+/-0.5)的组合，X方向上含“东”的为+，反之为-；Y方向上含“北”的为+，反之为-
3）构建做图辅助数据源（B14:C17)：光标置于“区域”单元格上的为(+/-0.5,+/-0.5)，反之为na()
其它做图要点：                                                                                                                          -- 此步同时适用于情景2
1）横坐标、纵坐标皆为原图表坐标轴，在“线型”选择带箭头的；
2）“东”、“北”为坐标轴标题，但要手动修改文字并调整位置；
3）小计为散点的数据标签，但需通过标签工具替换成“2014年小计”数值，且需手动调整位置；

2. 做一个自定义函数：myrow(d)        'd: 参数，为单元格
     通过自定义函数取出作为参数的单元格的行号放到单元格d11中

3.  函数：Hyperlink的一个神奇用法
     当光标置于包含该函数的单元格上时能自动触发程序运行
     数据源中区域和做图辅助数据源的关系：A6-->A14, A7-->A15, A8-->A16, A9-->A17
     数据源A6~A9的公式，举例
     A6 = IF(ISERROR(HYPERLINK(myrow(A14))),A14,)
     HYPERLINK(myrow(A14)) = #VALUE!, A6 = A14

4. 如何把每个散点替换成该区域对应的四个季度的饼图？                                                 -- 此步同时适用于情景2
1）另做一个饼图
2）利用对象chartobjects的方法Copypicture，复制饼图为图片到剪贴板
3）从剪贴板粘贴到四象限图的散点上
具体详见代码
---------------------------------------------------------------------------------------------------------------------------------------------
情景2
知识点：
1. 图表：散点图
2. VBA
1）sheet的selectionchange事件
2）对象chartobjects的方法Copypicture

做图概要：
通过sheet的selectionchange事件及activecell.row获得选中单元格信息的
其它基本同情景1相同，就不再细述。

批改和我的做法见附件。
图表太难改了，如对批改有不同意见，请联系我。