Макрос VBA для изменения цветов организационной диаграммы Visio не меняет цвет

Вопрос или проблема

У меня есть организационная схема, которая генерируется из таблицы Excel. В таблице и схеме есть поле “Источник”, чтобы показать, заполнена ли должность внутренним или внешним ресурсом.

Я хотел бы иметь возможность запустить макрос, который раскрасит внутренние и внешние ресурсы разными цветами. Я также хотел бы затенить текущие вакансии (имя = vacant) более светлым цветом.

У меня есть следующий код, который вносит изменения в фигуры, когда вы смотрите на листы фигур (ниже). Тем не менее, фактическая фигура не меняет цвет, даже когда я вручную экспериментирую с содержимым листа фигуры 🙁 Я так сбит с толку.

Sub ReColour()
Dim shp As Visio.Shape
Dim pagshape As Visio.Shape
Set pagshape = Visio.ActivePage.PageSheet

For Each shp In Visio.ActivePage.Shapes
    If shp.CellExistsU("prop.source", visExistsAnywhere) <> 0 Then 'Debug.Print shp.CellsU("prop.source").ResultStr(visNone)
        If shp.CellsU("prop.Source").ResultStr(visNone) = "HO - Full time (back filled)" Then
            shp.CellsU("Fillforegnd").FormulaU = "=THEMEGUARD(RGB(250,100,50))"
            shp.CellsU("FillBkgnd").FormulaU = "=THEMEGUARD(RGB(0,100,150))"
            shp.CellsU("Fillpattern").FormulaU = "27"
            Debug.Print shp.ID
        End If
    End If

Next shp

End Sub

Одно, что я заметил, это то, что на листе фигуры есть поле user.backFillColor, которое установлено на sheet.25!FillForegnd, где 25 — это ID фигуры. Это не то же самое, что =fillForegnd, и я очень сбит с толку, к чему указывает sheet25!, так как другая фигура (ID 155) на том же листе ссылается на sheet155!, так что это не похоже на другой лист 🙁

Любая помощь будет с благодарностью принята, так как это кажется чем-то простым, но фигуры ведут себя очень странно.

Ответ или решение

Конечно! Давайте разберем вашу проблему с изменением цветов на диаграмме оргструктуры в Visio с помощью VBA. На первый взгляд, код выглядит правильно, но есть несколько моментов, которые нужно проверить и исправить.

Проблемы

  1. Использование неверных названий ячеек: Вы используете Fillforegnd и FillBkgnd, но правильным именем должно быть FillForegnd (крупная буква F). Также убедитесь, что вы правильно задаете RGB-значения.

  2. Порядок официальных функций: Для изменения цвета заливки вы можете попробовать использовать ячейку, зависящую от цвета заливки самой фигуры.

  3. События обновления: Visio может не сразу обновлять отображение, если изменения происходят только в объектной модели, поэтому вам может потребоваться вызвать обновление.

Вот более полный и исправленный код, который должен решить вашу проблему:

Sub ReColour()
    Dim shp As Visio.Shape
    Dim pagshape As Visio.Shape
    Set pagshape = Visio.ActivePage.PageSheet

    For Each shp In Visio.ActivePage.Shapes
        If shp.CellExistsU("prop.source", visExistsAnywhere) <> 0 Then
            Dim sourceValue As String
            sourceValue = shp.CellsU("prop.Source").ResultStr(visNone)

            Select Case sourceValue
                Case "HO - Full time (back filled)"
                    shp.CellsU("FillForegnd").FormulaU = "=THEMEGUARD(RGB(250,100,50))"
                    shp.CellsU("FillBkgnd").FormulaU = "=THEMEGUARD(RGB(0,100,150))"
                    shp.CellsU("FillPattern").FormulaU = "27"

                Case "Vacant"
                    shp.CellsU("FillForegnd").FormulaU = "=RGB(200,200,200)" ' Цвет для вакансий
                    shp.CellsU("FillBkgnd").FormulaU = "=RGB(255,255,255)" ' Светлый фон

                Case "External"
                    shp.CellsU("FillForegnd").FormulaU = "=RGB(100,150,250)" ' Цвет для внешних
                    shp.CellsU("FillBkgnd").FormulaU = "=RGB(255,255,255)" ' Светлый фон для внешних

                ' Добавьте дополнительные условия по мере необходимости.

            End Select
            Debug.Print "Shape ID: " & shp.ID & ", Source: " & sourceValue
        End If
    Next shp

    ' Обновление всех форм, чтобы изменения отобразились
    Visio.ActivePage.Shapes.Repaint
End Sub

Объяснение кода

  1. Проверка "prop.source": Если свойство существует, код получает его значение и применяет соответствующий цвет в зависимости от условия.

  2. Разнообразие условий: Используются конструкции Select Case для повышения читаемости и возможности добавления новых условий.

  3. Перезагрузка форм: В конце макроса вызывается Shapes.Repaint, чтобы убедиться, что изменения отображаются на экране.

Дополнительные рекомендации

  • Убедитесь, что все нужные поля и значения правильно заданы в вашем Excel. Иногда опечатки могут привести к отсутствию изменений.
  • Запустите код с отладчиком, чтобы просмотреть значения переменных в каждом условии. Это поможет выявить возможные ошибки.
  • Если цвет не меняется, попробуйте вручную изменить цвет фигуры в Visio, чтобы удостовериться, что это возможно.

Если у вас возникнут дополнительные вопросы или проблемы, не стесняйтесь задавать их!

Оцените материал
Добавить комментарий

Капча загружается...