VBA创建Treemap，标签字段 [英] VBA create Treemap, label fields

问题描述

嗨！
$


我今天尝试创建一个树形图，在第一次循环运行期间，使用正确的数据创建了树形图，但随后又创建了树形图停止并指出错误

  .SetSourceData Source：= sourceOfDiagramTemp

可能因为这些不是树图的属性而是丛集柱图的属性？难道不知道为什么它停在那里或者使用什么命令代替？我怎么能把不同的盒子标记出来？
$
帮助真的很棒！

    Dim ws As Worksheet

    Dim x As Integer

    Dim shpTemp As Shape

    Dim sourceOfDiagramTemp作为Range'迭代overDiagramValues



    Dim balkenBeschriftung As Range





   设置ws = ThisWorkbook.Sheets（"TreeMap"）'总是使用固定的ws

   设置balkenBeschriftung = ws.Range（Cells（5,3），Cells（5,20））

    '如果有任何b $ b，请删除旧图表   如果不是ws.ChartObjects.count = 0那么ws.ChartObjects.Delete



       适用于x = 1至18


           设置sourceOfDiagramTemp = ws.Range（Cells（4 + x，3），Cells（4 + x，20））'为每次迭代设置行

       ;     设置shpTemp = ws.Shapes.AddChart2（201，xlTreemap，50％，200 + X * 240）

          &NBSP ;    使用shpTemp.Chart为
                   .SetSourceData来源：= sourceOfDiagramTemp


                    " .FullSeriesCollection（1）.xlValues = balkenBeschriftung

               结束与$
      下一页x

$

                                            

解决方案

如果以下解决问题，则可能是由于使用了单元格（..）。

 Sub asa（）
 
 Dim ws As Worksheet 
 Dim x As整数
尺寸shpTemp作为形状
尺寸sourceOfDiagramTemp如范围 '迭代overDiagramValues 
尺寸balkenBeschriftung作为范围
 
将WS = ThisWorkbook.Sheets（QUOT; TreeMap的"）' 总是使用固定的ws 
 
使用ws 
 
设置balkenBeschriftung = .Range（.Cells（5,3），。Cells（5,20））
 
'删除旧图表，如果有任何
如果没有.ChartObjects.Count = 0那么.ChartObjects.Delete 
 
对于x = 1到18 
 
设置sourceOfDiagramTemp = .Range（.Cells（4 + x，3），。Cells（4 + x，20））'为每次迭代设置行
设置shpTemp = .Shapes.AddChart 2（201，xlTreemap，50％，200 + X * 240）
将shpTemp.Chart 
 .SetSourceData来源：= sourceOfDiagramTemp 
" .FullSeriesCollection（1）.xlValues = balkenBeschriftung 
结束时
 
下一个x 
结束
结束子
 

Hi!

I tried to create a treemap today and during the first run of the loop a treemap was created with the right data but then it stopped and pointed out an error at

  .SetSourceData Source:=sourceOfDiagramTemp

Probably because these are no properties of a treemap but of a clusteredcolumn-chart? Does anyonw know why it stops there or what command to use instead? And how can I lable the different boxes?
Help would be really great!

    Dim ws As Worksheet
    Dim x As Integer
    Dim shpTemp As Shape
    Dim sourceOfDiagramTemp As Range 'iterate overDiagramValues

    Dim balkenBeschriftung As Range


    Set ws = ThisWorkbook.Sheets("TreeMap") 'always work with a fixed ws
    Set balkenBeschriftung = ws.Range(Cells(5, 3), Cells(5, 20))

    'Delete old Charts if there are any
    If Not ws.ChartObjects.count = 0 Then ws.ChartObjects.Delete

        For x = 1 To 18

            Set sourceOfDiagramTemp = ws.Range(Cells(4 + x, 3), Cells(4 + x, 20)) 'Set row for each iteration
            Set shpTemp = ws.Shapes.AddChart2(201, xlTreemap, 50, 200 + x * 240)
                With shpTemp.Chart
                   .SetSourceData Source:=sourceOfDiagramTemp
                   '.FullSeriesCollection(1).xlValues = balkenBeschriftung
                End With
        Next x

                                            

解决方案

If below solves the issue then it may be caused by using cells(..).

Sub asa()
    
    Dim ws As Worksheet
    Dim x As Integer
    Dim shpTemp As Shape
    Dim sourceOfDiagramTemp As Range 'iterate overDiagramValues
    Dim balkenBeschriftung As Range
    
    Set ws = ThisWorkbook.Sheets("TreeMap") 'always work with a fixed ws
        
    With ws
        
        Set balkenBeschriftung = .Range(.Cells(5, 3), .Cells(5, 20))
    
        'Delete old Charts if there are any
        If Not .ChartObjects.Count = 0 Then .ChartObjects.Delete
        
        For x = 1 To 18
        
            Set sourceOfDiagramTemp = .Range(.Cells(4 + x, 3), .Cells(4 + x, 20)) 'Set row for each iteration
            Set shpTemp = .Shapes.AddChart2(201, xlTreemap, 50, 200 + x * 240)
            With shpTemp.Chart
                .SetSourceData Source:=sourceOfDiagramTemp
                '.FullSeriesCollection(1).xlValues = balkenBeschriftung
            End With
        
        Next x
    End With
End Sub

这篇关于VBA创建Treemap，标签字段的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！