VBA编程设置不同透明度地图

寒江隐居客

Sub fill_color_Hubei()
    Dim J As Integer
    Application.ScreenUpdating = False '暂停刷新屏幕
        
    Select Case Range("湖北map!F1").Value
        Case 1: Range("湖北map!F1:G1").Interior.ColorIndex = 1
        Case 2: Range("湖北map!F1:G1").Interior.ColorIndex = 53
        Case 3: Range("湖北map!F1:G1").Interior.ColorIndex = 51
        Case 4: Range("湖北map!F1:G1").Interior.ColorIndex = 55
        Case 5: Range("湖北map!F1:G1").Interior.ColorIndex = 47
        Case 6: Range("湖北map!F1:G1").Interior.ColorIndex = 33
    End Select
              
    For J = 5 To 21  '为数据源的起始和结束行号
        
        ActiveSheet.Shapes(Range("湖北data!B" & J).Value).Fill.ForeColor.RGB = Range("湖北map!F1").Interior.Color
        '使用选定的颜色填充图形
        
        ActiveSheet.Shapes(Range("湖北data!B" & J).Value).Fill.Transparency = Range("湖北data!D" & J).Value
        '按匹配的透明度值设置图形的透明度

    Next J
   
    ActiveSheet.Shapes("My_legend_Hubei").Fill.ForeColor.RGB = Range("湖北map!F1").Interior.Color
        '设置图例的填充色
        
    ActiveSheet.Shapes("My_legend_Hubei").Fill.OneColorGradient msoGradientVertical, 2, 0.23
        '设置图例的渐变效果
        
        '若是2007，请使用以下2句
         ActiveSheet.Shapes("My_legend").Fill.BackColor.RGB = RGB(255, 255, 255)
         ActiveSheet.Shapes("My_legend").Fill.TwoColorGradient msoGradientVertical, 2
   
    Application.ScreenUpdating = True '恢复刷新屏幕
   
End Sub
不知道为什么一运行就出错。
涂红部分根据执行不下去。求助！

wmj1999

谢谢分享！