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

Вход

Регистрация

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

 

= Мир MS Excel/Построение фигур по таблице - Мир MS Excel

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

Excel 2007
Добрый вечер.
На таблице C4:G15 - в начале проставлены номера фигур и их названия (координаты размещения - неважны).
(сейчас макрос просто строит - всегда прямоугольник - только по первой строке.)

Видимо нужно вставить куда-то - кусок кода (чтобы он распознавал какой формы строить фигуру):
[vba]
Код

    Select Case tip
        Case "Овал": tip = msoShapeOval
        Case "Ромб": tip = msoShapeDiamond
        Case "Прямоугольник": tip = msoShapeRectangle
        Case "Равнобедренный треугольник": tip = msoShapeIsoscelesTriangle
        Case "Шестиугольник": tip = msoShapeHexagon
    End Select
[/vba]

Но вот куда именно - не пойму.

Как научить макрос - строить по всей этой таблице C4:G15 - фигуры (часть строк там - пустые) ?
К сообщению приложен файл: 9393354.xls(40.5 Kb)
 
Ответить
СообщениеДобрый вечер.
На таблице C4:G15 - в начале проставлены номера фигур и их названия (координаты размещения - неважны).
(сейчас макрос просто строит - всегда прямоугольник - только по первой строке.)

Видимо нужно вставить куда-то - кусок кода (чтобы он распознавал какой формы строить фигуру):
[vba]
Код

    Select Case tip
        Case "Овал": tip = msoShapeOval
        Case "Ромб": tip = msoShapeDiamond
        Case "Прямоугольник": tip = msoShapeRectangle
        Case "Равнобедренный треугольник": tip = msoShapeIsoscelesTriangle
        Case "Шестиугольник": tip = msoShapeHexagon
    End Select
[/vba]

Но вот куда именно - не пойму.

Как научить макрос - строить по всей этой таблице C4:G15 - фигуры (часть строк там - пустые) ?

Автор - Megamen2
Дата добавления - 13.11.2018 в 21:30
sboy Дата: Среда, 14.11.2018, 09:10 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2236
Репутация: 631 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Примерно так
[vba]
Код
Sub Макрос1()
arr = Cells(4, 3).CurrentRegion.Value
    For i = 2 To UBound(arr)
        If Not IsEmpty(arr(i, 2)) Then
            Select Case arr(i, 2)
                Case "Овал": tip = msoShapeOval
                Case "Ромб": tip = msoShapeDiamond
                Case "Прямоугольник": tip = msoShapeRectangle
                Case "Равнобедренный треугольник": tip = msoShapeIsoscelesTriangle
                Case "Шестиугольник": tip = msoShapeHexagon
            End Select
            
            If Not IsEmpty(tip) Then
                With ActiveSheet.Shapes.AddShape(tip, 20 + i * 10, 10 + i * 10, arr(i, 4), arr(i, 3))
                    .DrawingObject.Caption = arr(i, 5)
                    .Name = arr(i, 2) & " " & arr(i, 1)
                End With
                tip = Empty
            End If
        End If
    Next
End Sub
[/vba]
К сообщению приложен файл: 2911150.xls(42.5 Kb)
 
Ответить
СообщениеДобрый день.
Примерно так
[vba]
Код
Sub Макрос1()
arr = Cells(4, 3).CurrentRegion.Value
    For i = 2 To UBound(arr)
        If Not IsEmpty(arr(i, 2)) Then
            Select Case arr(i, 2)
                Case "Овал": tip = msoShapeOval
                Case "Ромб": tip = msoShapeDiamond
                Case "Прямоугольник": tip = msoShapeRectangle
                Case "Равнобедренный треугольник": tip = msoShapeIsoscelesTriangle
                Case "Шестиугольник": tip = msoShapeHexagon
            End Select
            
            If Not IsEmpty(tip) Then
                With ActiveSheet.Shapes.AddShape(tip, 20 + i * 10, 10 + i * 10, arr(i, 4), arr(i, 3))
                    .DrawingObject.Caption = arr(i, 5)
                    .Name = arr(i, 2) & " " & arr(i, 1)
                End With
                tip = Empty
            End If
        End If
    Next
End Sub
[/vba]

Автор - sboy
Дата добавления - 14.11.2018 в 09:10
Megamen2 Дата: Среда, 14.11.2018, 10:57 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
sboy, теперь нормально работает. Большое вам спасибо.
 
Ответить
Сообщениеsboy, теперь нормально работает. Большое вам спасибо.

Автор - Megamen2
Дата добавления - 14.11.2018 в 10:57
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Построение фигур по таблице (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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