首先，打开开发者模式，然后点击“宏”，新建一个宏，输入代码，然后选中需要转化的区域。

然后运行宏，即可完成。

代码如下：

转换图形 填充 为灰度

Sub ConvertSelectedToGrayscale()
    Dim sel As Visio.Selection
    Dim shp As Visio.Shape
    Dim fillColor As Visio.Cell
    Dim lineColor As Visio.Cell
    Dim colorStr As String
    Dim R As Double, G As Double, B As Double
    Dim gray As Double

    Set sel = Visio.ActiveWindow.Selection

    For Each shp In sel
        If shp.CellExistsU("FillForegnd", Visio.VisExistsFlags.visExistsAnywhere) Then
            Set fillColor = shp.CellsU("FillForegnd")
            colorStr = fillColor.FormulaU

            If Left(colorStr, 3) = "RGB" Then
                colorStr = Mid(colorStr, 5, Len(colorStr) - 5)
                R = CDbl(Split(colorStr, ",")(0))
                G = CDbl(Split(colorStr, ",")(1))
                B = CDbl(Split(colorStr, ",")(2))

                gray = 0.3 * R + 0.59 * G + 0.11 * B
                fillColor.FormulaU = "RGB(" & gray & "," & gray & "," & gray & ")"
            End If
        End If

        If shp.CellExistsU("LineColor", Visio.VisExistsFlags.visExistsAnywhere) Then
            Set lineColor = shp.CellsU("LineColor")
            colorStr = lineColor.FormulaU

            If Left(colorStr, 3) = "RGB" Then
                colorStr = Mid(colorStr, 5, Len(colorStr) - 5)
                R = CDbl(Split(colorStr, ",")(0))
                G = CDbl(Split(colorStr, ",")(1))
                B = CDbl(Split(colorStr, ",")(2))

                gray = 0.3 * R + 0.59 * G + 0.11 * B
                lineColor.FormulaU = "RGB(" & gray & "," & gray & "," & gray & ")"
            End If
        End If
    Next shp
End Sub

---

转换图形 边框 为灰度

Sub ConvertSelectedLinesToGrayscale()
    Dim sel As Visio.Selection
    Dim shp As Visio.Shape
    Dim lineColor As Visio.Cell
    Dim R As Double, G As Double, B As Double
    Dim gray As Double
    Dim colorValue As Double

    Set sel = Visio.ActiveWindow.Selection

    For Each shp In sel
        If shp.CellExistsU("LineColor", Visio.VisExistsFlags.visExistsAnywhere) Then
            Set lineColor = shp.CellsU("LineColor")
            colorValue = lineColor.ResultIU
            
            R = (colorValue And &HFF)
            G = (colorValue \ 256 And &HFF)
            B = (colorValue \ 65536 And &HFF)
            
            gray = 0.3 * R + 0.59 * G + 0.11 * B
            
            lineColor.FormulaU = "RGB(" & gray & "," & gray & "," & gray & ")"
        End If
    Next shp
End Sub

2024年7月22日