Рисование границ на таблице

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рисование границ на таблице (Макросы/Sub)

DimOzerov

Дата: Пятница, 19.10.2018, 00:34 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 68

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте.
Подскажите - как изменить макрос.

Краткая предыстория:

Макрос формирует таблицу, по текстовому коду.
B6(1x2\2x7\3x1\4x1)(1x1\2x1\3x1)

B6 - это целевая ячейка, от которой нужно начинать строить таблицу.
От целевой ячейки - первые скобки - это столбцы (номер столбца х его ширина. А затем через \ идет другой столбец)
Ширина 1 - означает обычную одинарную ячейку. Ширина 2 - означает ячейку вдвое более широкую чем одинарная.
Вторые скобки - это строки (номер строки х ее высота. И через \ другие строки.)

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

Как сделать обводку границами - ячеек - данной таблицы ?

К сообщению приложен файл: 8293943.xls (44.5 Kb)

Ответить

GWolf

Дата: Пятница, 19.10.2018, 06:22 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 34

Репутация: 3 ±

Замечаний: 0% ±

Доброго дня!

Как - то так:
[vba]

Код

Sub q()
'стандартная ширина и высота
    Dim k As Long, m As Long

w = Range("A1").ColumnWidth
h = Range("A1").RowHeight
    s = "B6(1x2\2x7\3x1\4x1)(1x1\2x3\3x2)"
    spl = Split(Replace(s, ")", ""), "(")
    cellOne = spl(0)
    spl1 = Split(spl(1), "\")
    For i = 0 To UBound(spl1)
        spl11 = Split(spl1(i), "x")
        With Range(spl(0)).Offset(, spl11(0) - 1)
            .EntireColumn.ColumnWidth = spl11(1) * w
        End With
    Next
    spl2 = Split(spl(2), "\")
    For j = 0 To UBound(spl2)
        spl22 = Split(spl2(j), "x")
        With Range(spl(0)).Offset(spl22(0) - 1)
            .EntireRow.RowHeight = spl22(1) * h
        End With
    Next

    For k = 0 To i
        For m = 0 To j
            With Range(spl(0)).Offset(k, m)
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlEdgeTop).Weight = xlThin
            End With
        Next m
    Next k
End Sub

[/vba]

Путей к вершине множество. Этот один из многих...

Ответить

bmv98rus

Дата: Пятница, 19.10.2018, 07:55 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4106

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

ну наверно так лучше
[vba]

Код

            With Range(spl(0)).Resize(i + 1, j + 1)
                .Borders(xlEdgeLeft).Weight = xlThin
                .Borders(xlEdgeBottom).Weight = xlThin
                .Borders(xlEdgeRight).Weight = xlThin
                .Borders(xlEdgeTop).Weight = xlThin
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
            End With

[/vba]