Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693209 Sun, 13 Nov 2016 05:42:26 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693209 Цитата Руслан @
В любом случае, к чему это?

К тому, что в зависимости от разрядности среды изменяют свой размер только указатели и дескрипторы, а тип DWORD имеет размер 32 бита независимо от разрядности среды, поэтому объявлять его в VB нужно как As Long, а не LongPtr.

Цитата Руслан @
Есть предложение как правильней подключить Sleep?

Есть - в твоем "нарытом в нэте" объявлении заменить LongPtr на Long - и всё.]]> leo VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693121 Sat, 12 Nov 2016 06:26:12 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693121 Цитата leo @
Тип LongPtr используется только для указателей и дескрипторов

Цитата
LongPtr преобразуется в тип Long в 32-разрядных средах или в тип LongLong в 64-разрядных средах.
(office 2013+) https://msdn.microsoft.com/ru-ru/library/of...e/gg251378.aspx

В любом случае, к чему это? Есть вариант, как подключить sleep более совместимым с разными версиями excel, или что?]]> Руслан VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693118 Sat, 12 Nov 2016 05:40:25 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693118 Цитата Руслан @
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems

Тип LongPtr используется только для указателей и дескрипторов (хэндлов), а параметр dwMilliseconds в Sleep имеет тип DWORD (32 бит), поэтому объявлять его как LongPtr не нужно (хотя и можно - ошибки не будет).]]> leo VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693110 Sat, 12 Nov 2016 03:01:50 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693110 Руслан VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693098 Fri, 11 Nov 2016 19:24:01 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3693098 DIS VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689592 Wed, 19 Oct 2016 18:31:10 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689592
    'часть для не допущения повторного запуска функции:
    Static fRunning As Boolean 'прикрутим переменную, показывающую, что макрос уже запущен
    If fRunning Then
        fRunning = False 'если макрос уже запушеен - запомнить что не запущен,
        End 'и окночить его выполнение. - Да, вот такая интересная "логика" у ВБ оказалась... ))
    End If
       fRunning = True ' Укажем, что макрос запущен


    'а это крутилка:  :)
        Do 'вечный цикл
            For i = 0 To 360 Step 5
                Application.Calculation = xlCalculationManual 'отключаем пересчет таблицы - для нормального отображения, блин...
                s.ThreeD.RotationX = i
                Application.Calculation = xlCalculationAutomatic 'для отображения графических изменений... 21й век, блин методы...
                DoEvents ' Даем Excel команду обработать пользовательский ввод
                Sleep 50
            Next i
            DoEvents ' Даем Excel команду обработать пользовательский ввод
        Loop

Возможно встанет вопрос как прикрутить Sleep мс? Где нить сверху когда обьявить примерно такую фишку(в нэте нарыл, надеюсь помог вам не рыть всё, чо самому пришлось):
    #If VBA7 Then
        Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
    #Else
        Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
]]> Руслан VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689572 Wed, 19 Oct 2016 16:24:35 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689572 Короче, кто ищет, тот найдет!
Попер я значит в свойства прямоугольника (правой кнопкой, "формат фигуры"), смотрю - есть же 3Д упоминания! А раз есть - значит и менять его можно в ВБ.
Захожу в ВБ редактор, view\locals window - отображаем окно со свойствами обьектов.
Ставлю БП(BreakPoint) на строчку выше обращения к прямоугольнику - кнопкой F9. Потом кнопкой F8 дохожу до обработки своего обьекта - s. Наблюдаю появление возможности посмотреть какие свойства можно менять у обьекта!! Ура!

Untitled_1.jpg (, : 729)

В итоге добавляю в обработчик:
        s.Width = Range("B5").Value
        s.Height = Range("C5").Value
        s.ThreeD.BevelTopDepth = Range("B6").Value
        s.ThreeD.RotationX = Range("B9").Value
        s.ThreeD.RotationY = Range("B10").Value
        s.ThreeD.RotationZ = Range("B11").Value


И вуаля! Всё работает, параллелепипед изобретён, и даже вращается при изменении ячеек B9=-30 B10=20 B11=0 :) :) :)]]> Руслан VB for Application https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689558 Wed, 19 Oct 2016 15:08:17 +0000 Рисование в excel прямоугольника https://forum.sources.ru/index.php?showtopic=409759&view=findpost&p=3689558 Сформировал табличку с данными по размерам\стоимости листового текстолита, дальше считаю стоимость изделий(плат, вообще то, но вот решил ради интереса посчитать и коробку, собранную из него же - параллелепипедом ботаны обзывают этот трехмерный прямоугольник)...
И всё прекрасно считается, но не хватает визуализации! - Вроде не в каменном же веке живём, автоматизация + визуализации, все дела... :rolleyes:

Вставка, фигуры, прямоугольник - получилось вставить!
Добавить функцию изменения размеров прямоугольника - получилось:
    Sub Прямоугольник1()
    Set s = ActiveSheet.Shapes("Прямоугольник 1")
        s.DrawingObject.Caption = Range("A5") 'текст в прямоугольнике
        s.Width = Range("B5").Value 'ширина
        s.Height = Range("C5").Value 'высота
    End Sub


Добавить авто-применение размеров, при изменении значений в ячейке - получилось (пр.кн.мышки по вкладке "Лист2", "исходный текст"):
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Application.Run "Прямоугольник1"
    End Sub

И всё бы хорошо, но продолжать в том же духе, рисуя параллелепипед из прямоугольников и линий - по моему несколько извратно, для 21го века... Неужели нет способа проще? - редактировать сразу параллелепипед, придав ему x,y,z, и может быть даже некое вращение, уклон? :rolleyes:]]> Руслан VB for Application