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

Вход

Регистрация

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

 

= Мир MS Excel/Рисование границ на таблице - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рисование границ на таблице (Макросы/Sub)
Рисование границ на таблице
DimOzerov Дата: Пятница, 19.10.2018, 00:34 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 0% ±

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

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

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

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

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

Как сделать обводку границами - ячеек - данной таблицы ?
К сообщению приложен файл: 8293943.xls(44.5 Kb)
 
Ответить
СообщениеЗдравствуйте.
Подскажите - как изменить макрос.

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

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

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

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

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

Автор - DimOzerov
Дата добавления - 19.10.2018 в 00:34
GWolf Дата: Пятница, 19.10.2018, 06:22 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 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]


Путей к вершине множество. Этот один из многих...
 
Ответить
СообщениеДоброго дня!

Как - то так:
[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]

Автор - GWolf
Дата добавления - 19.10.2018 в 06:22
bmv98rus Дата: Пятница, 19.10.2018, 07:55 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1395
Репутация: 235 ±
Замечаний: 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]
 
Ответить
Сообщениену наверно так лучше
[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]

Автор - bmv98rus
Дата добавления - 19.10.2018 в 07:55
GWolf Дата: Пятница, 19.10.2018, 08:03 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 3 ±
Замечаний: 0% ±

Доброго дня, Вам bmv98rus!
Согласен с Вами. На скрепке файл с Вашим вариантом кода.
К сообщению приложен файл: 6061426.xls(43.5 Kb)


Путей к вершине множество. Этот один из многих...
 
Ответить
СообщениеДоброго дня, Вам bmv98rus!
Согласен с Вами. На скрепке файл с Вашим вариантом кода.

Автор - GWolf
Дата добавления - 19.10.2018 в 08:03
Pelena Дата: Пятница, 19.10.2018, 08:30 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 13220
Репутация: 2908 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Вроде, даже так работает
[vba]
Код
    With Range(spl(0)).Resize(i + 1, j + 1)
        .Borders.Weight = xlThin
    End With
[/vba]
или
[vba]
Код
Range(spl(0)).Resize(i + 1, j + 1).Borders.Weight = xlThin
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеВроде, даже так работает
[vba]
Код
    With Range(spl(0)).Resize(i + 1, j + 1)
        .Borders.Weight = xlThin
    End With
[/vba]
или
[vba]
Код
Range(spl(0)).Resize(i + 1, j + 1).Borders.Weight = xlThin
[/vba]

Автор - Pelena
Дата добавления - 19.10.2018 в 08:30
bmv98rus Дата: Пятница, 19.10.2018, 10:00 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 1395
Репутация: 235 ±
Замечаний: 0% ±

Excel 2013/2016
Pelena, #3 это из расчета если контур зажирненый потребуется :-)

P.S. зажирнение - не мое, украл у Александра вчера читал, уж больно понравилось
Запишите макрорекодером зажирнение части текста


Сообщение отредактировал bmv98rus - Пятница, 19.10.2018, 10:01
 
Ответить
СообщениеPelena, #3 это из расчета если контур зажирненый потребуется :-)

P.S. зажирнение - не мое, украл у Александра вчера читал, уж больно понравилось
Запишите макрорекодером зажирнение части текста

Автор - bmv98rus
Дата добавления - 19.10.2018 в 10:00
RAN Дата: Пятница, 19.10.2018, 10:01 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4882
Репутация: 974 ±
Замечаний: 0% ±

2010
[vba]
Код
    Range(spl(0)).Resize(UBound(spl2) + 1, UBound(spl1) + 1).Borders.LineStyle = xlContinuous
[/vba]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Пятница, 19.10.2018, 10:03
 
Ответить
Сообщение[vba]
Код
    Range(spl(0)).Resize(UBound(spl2) + 1, UBound(spl1) + 1).Borders.LineStyle = xlContinuous
[/vba]

Автор - RAN
Дата добавления - 19.10.2018 в 10:01
DimOzerov Дата: Пятница, 19.10.2018, 13:23 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 52
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
GWolf, RAN, Pelena, bmv98rus, спасибо за ответы.
 
Ответить
СообщениеGWolf, RAN, Pelena, bmv98rus, спасибо за ответы.

Автор - DimOzerov
Дата добавления - 19.10.2018 в 13:23
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рисование границ на таблице (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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