Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Изменить тип заполнения формы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Изменить тип заполнения формы
user0 Дата: Четверг, 09.11.2017, 15:03 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
Доброго времени суток,

Простой вопрос по visio, необходимо поменять стиль заполнения с паттерна на сплошной для всех прямоугольников на всех листах.
местный макрорекордер записывает изменение типа заполнения .FormulaU = "1", где 1 - сплошной, 2 - паттерн, но почему-то при изменение для всех прямоугольников с заполнением 1 на 2 не дает желаемого результата.
[vba]
Код
Application.ActiveWindow.Page.Shapes.ItemFromID(XXX).CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
[/vba]

[vba]
Код
Option Explicit
Sub FormatShapes()
    Dim oApp As Object
    Dim doc As Object
    Dim shp As Shape
    Dim pg As Page
    Dim i As Integer

    Dim cGreen As String
    Dim cGrey As String
    Dim cBlue As String
    Dim cRed As String

    cGreen = "THEMEGUARD(RGB(51,204,51))"
    cGrey = "THEMEGUARD(RGB(191,191,191))"
    cBlue = "THEMEGUARD(RGB(117,159,204))"
    cRed = "THEMEGUARD(RGB(197,90,17))"

    Set oApp = GetObject(, "visio.application")
    Set doc = oApp.ActiveDocument

    i = 1
    For Each pg In doc.Pages
    Application.ActiveWindow.ViewFit = visFitPage
        For Each shp In pg.Shapes

            If Not shp.OneD Then
                If shp.Name Like "Rectangle.*" Then
                    With pg.Shapes.ItemFromID(shp.ID)
                        Debug.Print pg.Name & " _ " & shp.Name & " - " & .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU

                        'change fill color from pattern to solid ?
                        If .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "2" Then  '1 - solid, 2 - pattern
                            .CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaForceU = cGreen
                            .CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaForceU = cGreen
                            .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
                        End If
                    End With
                End If
            End If

        Next shp
        i = i + 1
    Next
End Sub
[/vba]

Rectangle.39 должен стать таким же как Rectangle.2
К сообщению приложен файл: changeFill.vsdm (42.0 Kb)


Сообщение отредактировал user0 - Четверг, 09.11.2017, 15:11
 
Ответить
СообщениеДоброго времени суток,

Простой вопрос по visio, необходимо поменять стиль заполнения с паттерна на сплошной для всех прямоугольников на всех листах.
местный макрорекордер записывает изменение типа заполнения .FormulaU = "1", где 1 - сплошной, 2 - паттерн, но почему-то при изменение для всех прямоугольников с заполнением 1 на 2 не дает желаемого результата.
[vba]
Код
Application.ActiveWindow.Page.Shapes.ItemFromID(XXX).CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
[/vba]

[vba]
Код
Option Explicit
Sub FormatShapes()
    Dim oApp As Object
    Dim doc As Object
    Dim shp As Shape
    Dim pg As Page
    Dim i As Integer

    Dim cGreen As String
    Dim cGrey As String
    Dim cBlue As String
    Dim cRed As String

    cGreen = "THEMEGUARD(RGB(51,204,51))"
    cGrey = "THEMEGUARD(RGB(191,191,191))"
    cBlue = "THEMEGUARD(RGB(117,159,204))"
    cRed = "THEMEGUARD(RGB(197,90,17))"

    Set oApp = GetObject(, "visio.application")
    Set doc = oApp.ActiveDocument

    i = 1
    For Each pg In doc.Pages
    Application.ActiveWindow.ViewFit = visFitPage
        For Each shp In pg.Shapes

            If Not shp.OneD Then
                If shp.Name Like "Rectangle.*" Then
                    With pg.Shapes.ItemFromID(shp.ID)
                        Debug.Print pg.Name & " _ " & shp.Name & " - " & .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU

                        'change fill color from pattern to solid ?
                        If .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "2" Then  '1 - solid, 2 - pattern
                            .CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaForceU = cGreen
                            .CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaForceU = cGreen
                            .CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
                        End If
                    End With
                End If
            End If

        Next shp
        i = i + 1
    Next
End Sub
[/vba]

Rectangle.39 должен стать таким же как Rectangle.2

Автор - user0
Дата добавления - 09.11.2017 в 15:03
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!