Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 06.01.2019, 23:18   #1
odeon16
Пользователь
 
Регистрация: 02.01.2017
Сообщений: 14
По умолчанию Расстановка объектов внутри шейпов - в случайных координатах

Уважаемые форумчане, Помогите решить вопрос.

Имеющийся макрос - размещает по листу объекты, и вписывает в них объекты поменьше.
Однако он для этих мелких объектов - назначает одну и ту же фиксированную координату. И мелкие объекты - всегда в единственном числе.

Скажите - как изменить макрос, чтобы мелкие объекты - проставлялись внутри основных фигур - в случайном порядке (случайные координаты), а не фиксированном ?

Число мелких объектов - указано в ячейке P8 и S8
Вложения
Тип файла: xls 1.xls (51.5 Кб, 15 просмотров)
odeon16 вне форума Ответить с цитированием
Старый 07.01.2019, 18:33   #2
jillitil
Форумчанин
 
Аватар для jillitil
 
Регистрация: 17.10.2018
Сообщений: 184
По умолчанию

У элементов есть св-ва ширины и высоты ActiveSheet.Shapes(name).Width и .Height. Используйте их чтоб определить диапазон случайных чисел.
Shape(треугольник).Top = Shape(КриваяОбласть).Top + (Rnd * Shape(КриваяОбласть).Height)
jillitil вне форума Ответить с цитированием
Старый 07.01.2019, 22:54   #3
odeon16
Пользователь
 
Регистрация: 02.01.2017
Сообщений: 14
По умолчанию

jillitil, но там сейчас добавляется всего одна минифигура.

Как добавить несколько минифигур ?
(Столько, сколько написано в ячейке P8 и S8 )
odeon16 вне форума Ответить с цитированием
Старый 09.01.2019, 22:08   #4
alex777555
Пользователь
 
Регистрация: 30.07.2018
Сообщений: 19
По умолчанию

Организуй цикл
alex777555 вне форума Ответить с цитированием
Старый 10.01.2019, 00:53   #5
odeon16
Пользователь
 
Регистрация: 02.01.2017
Сообщений: 14
По умолчанию

alex777555, а как, хотя бы примерно - должен выглядеть такой цикл ?
odeon16 вне форума Ответить с цитированием
Старый 10.01.2019, 06:03   #6
odeon16
Пользователь
 
Регистрация: 02.01.2017
Сообщений: 14
По умолчанию

Изменил свой .
Теперь он выглядит вот так:
Код:
Option Explicit

Sub MakeSameCopy()
  CopyShape "Полилиния 4", [n9], "Равнобедренный треугольник 9"
  CopyShape "Овал 1", [q9], "Равнобедренный треугольник 10"
End Sub


Sub CopyShape(name$, koord As Range, name1$)
  Do While Not IsEmpty(koord)
    ActiveSheet.Shapes(name).Copy: ActiveSheet.Paste
    Selection.Left = koord: Selection.Top = koord.Offset(0, 1)
        If koord.Offset(0, 2) Then
        ActiveSheet.Shapes(name1).Copy: ActiveSheet.Paste
        Selection.Left = koord + Rnd * ActiveSheet.Shapes(Range("N7")).Width: Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Range("N7")).Height '
        End If
        
        If koord.Offset(0, 2) Then
        ActiveSheet.Shapes(name1).Copy: ActiveSheet.Paste
        Selection.Left = koord + Rnd * ActiveSheet.Shapes(Range("N7")).Width: Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Range("N7")).Height
        End If
        
        If koord.Offset(0, 2) Then
        ActiveSheet.Shapes(name1).Copy: ActiveSheet.Paste
        Selection.Left = koord + Rnd * ActiveSheet.Shapes(Range("N7")).Width: Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Range("N7")).Height
        End If
        
        If koord.Offset(0, 2) Then
        ActiveSheet.Shapes(name1).Copy: ActiveSheet.Paste
        Selection.Left = koord + Rnd * ActiveSheet.Shapes(Range("N7")).Width: Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Range("N7")).Height
        End If
        
        If koord.Offset(0, 2) Then
        ActiveSheet.Shapes(name1).Copy: ActiveSheet.Paste
        Selection.Left = koord + Rnd * ActiveSheet.Shapes(Range("N7")).Width: Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Range("N7")).Height
        End If
    Set koord = koord.Offset(1, 0)
  Loop
End Sub
Но в этом случае приходится условие If-end If прописывать вручную пять раз.
Как же связать эти количества условий с ячейками P8 и S8 ?

Потом - случайные координаты - прописываются только для одного объекта, название которого в ячейке N7.
А как прописать те же координаты для объекта, название которого находится в ячейке Q7 ?
Вложения
Тип файла: xls 1--.xls (61.0 Кб, 11 просмотров)
odeon16 вне форума Ответить с цитированием
Старый 10.01.2019, 14:03   #7
jillitil
Форумчанин
 
Аватар для jillitil
 
Регистрация: 17.10.2018
Сообщений: 184
По умолчанию

Код:
Sub MakeSameCopy()
  CopyShape [n7], "Равнобедренный треугольник 9", [n9], [p8]
  CopyShape [q7], "Равнобедренный треугольник 10", [q9], [s8]
End Sub

Sub CopyShape(Name1$, Name2$, koord As Range, Count As Integer)
  Dim i As Integer              ' Счетчик для цикла
  Do While Not IsEmpty(koord)
    ActiveSheet.Shapes(Name1$).Copy
    ActiveSheet.Paste
    Selection.Left = koord
    Selection.Top = koord.Offset(0, 1)
    
      For i = 1 To Count
        If koord.Offset(0, 2) Then
          ActiveSheet.Shapes(Name2$).Copy
          ActiveSheet.Paste
          Selection.Left = koord + Rnd * ActiveSheet.Shapes(Name1$).Width
          Selection.Top = koord.Offset(0, 1) + Rnd * ActiveSheet.Shapes(Name1$).Height
        Else
          Exit For
        End If
    Next
    Set koord = koord.Offset(1, 0)
  Loop
End Sub

Последний раз редактировалось jillitil; 10.01.2019 в 15:29.
jillitil вне форума Ответить с цитированием
Старый 10.01.2019, 16:38   #8
odeon16
Пользователь
 
Регистрация: 02.01.2017
Сообщений: 14
По умолчанию

jillitil, большое спасибо.
Теперь все заработало как надо.
odeon16 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите разобраться - Пишу маленькую игру на Swing по типу PacMan, сделать генерацию случайных объектов на игровом поле Nukz Общие вопросы по Java, Java SE, Kotlin 9 31.03.2017 12:57
делфи7. Напишите обработчик события onClick компоненты Button1, который закрашивает компоненту Image1 целиком белым цветом и рисует 100 черных точек в случайных координатах Наталочка12 Помощь студентам 7 12.01.2017 13:02
C++ не могу понять как сделать массив объектов одного класса в другом (задание внутри) Vladimir_Anatol Помощь студентам 2 12.03.2012 18:56
Нахождение слов-анаграмм, Ошибка выдается. Задание внутри. Код внутри. TYMON Общие вопросы .NET 2 22.11.2010 21:07
Помогите написать Visio add-in для экспорта из диаграммы выделенных шейпов в виде jpg artemvyrtosu Общие вопросы .NET 0 12.08.2009 11:50