关于通过VBA让地图各省板块变色的问题

louiszoom

木槿花西月锦绣 发表于 2024-7-6 18:02
想要把带文字的矩形都设置成无填充
为啥代码没有作用？

or i = 2 To UBound(Arr)
Dim all_ll
all_ll = Arr(i, 7)
ActiveSheet.Shapes.Range(Array("Freeform " & all_ll)).Select
    With Selection.ShapeRange.Fill
      .Visible = msoTrue
        
        .ForeColor.RGB = RGB(0, 176, 240)
        .Transparency = 0
       .Solid
   End With
Next
   
   
For i = 2 To UBound(Arr)
Dim ll

Dim new_name
new_name = Sheet1.[I3].Text

If Arr(i, 6) = new_name Then
ll = Arr(i, 7)


    ActiveSheet.Shapes.Range(Array("Freeform " & ll)).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With


End If
Next
==========
写的不好 主要是连带变动的问题，最好写到下拉框里头去，我比较LAN

木槿花西月锦绣

louiszoom 发表于 2024-7-11 14:57
or i = 2 To UBound(Arr)
Dim all_ll
all_ll = Arr(i, 7)

直接放在Change事件里吧
可能有的版本不持支数据有效性选择变动

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
   
    Dim i&, Myr&, Arr, bsrr, ii, arr1
    Dim d, k, t, dd, tt, cs, ttt, tttt
    Dim js1, js2, js3, js4, js1add, js2add
   
    Myr = Sheet1.[b65536].End(xlUp).Row
    Arr = Sheet1.Range("b2:h" & Myr)
    Dim all_ll
    For i = 2 To UBound(Arr)
        all_ll = Arr(i, 7)
        ActiveSheet.Shapes.Range(Array("Freeform " & all_ll)).Select
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 176, 240)
            .Transparency = 0
            .Solid
        End With
    Next
   
    Dim ll
    Dim new_name
    new_name = Sheet1.[I3].Text
    For i = 2 To UBound(Arr)
        If Arr(i, 6) = new_name Then
        ll = Arr(i, 7)
        ActiveSheet.Shapes.Range(Array("Freeform " & ll)).Select
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
            .Solid
        End With
        End If
    Next
    Application.ScreenUpdating = True
    Sheet1.[a1].Select
End Sub

louiszoom

木槿花西月锦绣 发表于 2024-7-11 17:27
直接放在Change事件里吧
可能有的版本不持支数据有效性选择变动

最好放在下拉框 用VBA模拟的单元格下拉框

louiszoom

木槿花西月锦绣 发表于 2024-7-11 17:27
直接放在Change事件里吧
可能有的版本不持支数据有效性选择变动

对对 不用选择变化 我单位的机子上改不过来

木槿花西月锦绣

louiszoom 发表于 2024-7-11 20:22
对对 不用选择变化 我单位的机子上改不过来

以前的版本也是这样
试了很多办法都不行
现在365 直接搞定