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

Вход

Регистрация

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

 

= Мир MS Excel/Показать координаты всех перемещений картинки в ЮзерФорме - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Показать координаты всех перемещений картинки в ЮзерФорме (Макросы/Sub)
Показать координаты всех перемещений картинки в ЮзерФорме
t330 Дата: Понедельник, 18.03.2019, 17:35 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Добрый день, уважаемые коллеги.

Во вложении пример кода, где картинку в юзерформе можно двигать мышью.
Параметры ImageLeft и ImageTop меняются во время движения этой картинки в каждый момент времени и перезаписываются в ячейку A1 и B1 (см строки кода №10 и №20), и в итоге в ячейках А1 и В1 остаются координаты только последнего положения картинки на юзерформе...

Как сделать так, чтобы все паарметры ImageLeft и ImageTop по мере перемещения картинки мышью записывались в столбец А и В не перезатирая друг -друга, ну или как занести в массив все координаты X и Y у картинки во время перемещения по юзерформе, а не только последние?

Заранее спасибо за ответ!:)

[vba]
Код
Option Explicit

'Положение диалогового окна UserForm
Dim OldX As Double, OldY As Double

Private Sub Image1_MouseDown(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'   Начальное положение при нажатой кнопке
    OldX = X
    OldY = Y
    Image1.ZOrder 0
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'   Перемещение изображения
    Dim r As Integer
    If Button = 1 Then
        'Debug.Print OldX, Image1.Left
        
        Image1.Left = Image1.Left + (X - OldX)
        Image1.Top = Image1.Top + (Y - OldY)
        
        r = r + 1
10    ActiveSheet.Cells(r, 1).Value = Image1.Left
20    ActiveSheet.Cells(r, 2).Value = Image1.Top
    End If
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

[/vba]
К сообщению приложен файл: move_controls.xlsm (26.2 Kb)


Сообщение отредактировал t330 - Понедельник, 18.03.2019, 17:39
 
Ответить
СообщениеДобрый день, уважаемые коллеги.

Во вложении пример кода, где картинку в юзерформе можно двигать мышью.
Параметры ImageLeft и ImageTop меняются во время движения этой картинки в каждый момент времени и перезаписываются в ячейку A1 и B1 (см строки кода №10 и №20), и в итоге в ячейках А1 и В1 остаются координаты только последнего положения картинки на юзерформе...

Как сделать так, чтобы все паарметры ImageLeft и ImageTop по мере перемещения картинки мышью записывались в столбец А и В не перезатирая друг -друга, ну или как занести в массив все координаты X и Y у картинки во время перемещения по юзерформе, а не только последние?

Заранее спасибо за ответ!:)

[vba]
Код
Option Explicit

'Положение диалогового окна UserForm
Dim OldX As Double, OldY As Double

Private Sub Image1_MouseDown(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'   Начальное положение при нажатой кнопке
    OldX = X
    OldY = Y
    Image1.ZOrder 0
End Sub

Private Sub Image1_MouseMove(ByVal Button As Integer, _
    ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'   Перемещение изображения
    Dim r As Integer
    If Button = 1 Then
        'Debug.Print OldX, Image1.Left
        
        Image1.Left = Image1.Left + (X - OldX)
        Image1.Top = Image1.Top + (Y - OldY)
        
        r = r + 1
10    ActiveSheet.Cells(r, 1).Value = Image1.Left
20    ActiveSheet.Cells(r, 2).Value = Image1.Top
    End If
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

[/vba]

Автор - t330
Дата добавления - 18.03.2019 в 17:35
_Boroda_ Дата: Понедельник, 18.03.2019, 17:48 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
        With ActiveSheet
            r = .Cells(.Rows.Count, 1).End(3).Row + 1
            .Cells(r, 1).Value = Image1.Left
            .Cells(r, 2).Value = Image1.Top
        End With
[/vba]
К сообщению приложен файл: move_controls_1.xlsm (26.3 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
        With ActiveSheet
            r = .Cells(.Rows.Count, 1).End(3).Row + 1
            .Cells(r, 1).Value = Image1.Left
            .Cells(r, 2).Value = Image1.Top
        End With
[/vba]

Автор - _Boroda_
Дата добавления - 18.03.2019 в 17:48
t330 Дата: Вторник, 19.03.2019, 00:37 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Так нужно?

Точно,спасибо!
 
Ответить
Сообщение
Так нужно?

Точно,спасибо!

Автор - t330
Дата добавления - 19.03.2019 в 00:37
t330 Дата: Вторник, 19.03.2019, 01:33 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Так нужно?


Данный код заполняетс столбцы начиная со второй строки, из-за того, что даже при пустом листе, выражение
[vba]
Код
r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
[/vba] возвращает 2

Чтобы заставить заполнять столбцы с первой строки, пришлось извратиться

[vba]
Код

         With ActiveSheet
            r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            If IsEmpty(.Cells(r - 1, 1)) Then
            .Cells(r - 1, 1).Value = Image1.Left
            .Cells(r - 1, 2).Value = Image1.Top
            Else
            .Cells(r, 1).Value = Image1.Left
            .Cells(r, 2).Value = Image1.Top
            End If
        End With
[/vba]

Может есть более изящный способ заставить заполняться с первой строки?
 
Ответить
Сообщение
Так нужно?


Данный код заполняетс столбцы начиная со второй строки, из-за того, что даже при пустом листе, выражение
[vba]
Код
r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
[/vba] возвращает 2

Чтобы заставить заполнять столбцы с первой строки, пришлось извратиться

[vba]
Код

         With ActiveSheet
            r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            If IsEmpty(.Cells(r - 1, 1)) Then
            .Cells(r - 1, 1).Value = Image1.Left
            .Cells(r - 1, 2).Value = Image1.Top
            Else
            .Cells(r, 1).Value = Image1.Left
            .Cells(r, 2).Value = Image1.Top
            End If
        End With
[/vba]

Может есть более изящный способ заставить заполняться с первой строки?

Автор - t330
Дата добавления - 19.03.2019 в 01:33
krosav4ig Дата: Вторник, 19.03.2019, 02:39 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
       With ActiveSheet
            With .Cells(.Rows.Count, 1).End(xlUp)
                With .Offset(-Not IsEmpty(.Value))
                    .Value = Image1.Left
                    .Cells(1, 2) = Image1.Top
                End With
            End With
        End With
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 19.03.2019, 02:44
 
Ответить
Сообщение[vba]
Код
       With ActiveSheet
            With .Cells(.Rows.Count, 1).End(xlUp)
                With .Offset(-Not IsEmpty(.Value))
                    .Value = Image1.Left
                    .Cells(1, 2) = Image1.Top
                End With
            End With
        End With
[/vba]

Автор - krosav4ig
Дата добавления - 19.03.2019 в 02:39
t330 Дата: Вторник, 19.03.2019, 13:26 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
@krosav4ig

Спасибо!
Не могли бы Вы пояснить строку
[vba]
Код
.Offset(-Not IsEmpty(.Value))
[/vba]

оператор offset должен же что-то смещать по строкам и/или столбцам, а тут вообще не указано на сколько и куда задано смещение...
 
Ответить
Сообщение@krosav4ig

Спасибо!
Не могли бы Вы пояснить строку
[vba]
Код
.Offset(-Not IsEmpty(.Value))
[/vba]

оператор offset должен же что-то смещать по строкам и/или столбцам, а тут вообще не указано на сколько и куда задано смещение...

Автор - t330
Дата добавления - 19.03.2019 в 13:26
krosav4ig Дата: Вторник, 19.03.2019, 13:40 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
t330,все там указано, not IsEmpty() возвращает тип данных Boolean
Цитата Boolean Data Type (Visual Basic)When Visual Basic converts Boolean values to numeric types, False becomes 0 and True becomes -1.[/quote ()

т.е. на выходе получаем если ячейка пустая -0, если не пустая --1


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 19.03.2019, 13:41
 
Ответить
Сообщениеt330,все там указано, not IsEmpty() возвращает тип данных Boolean
Цитата Boolean Data Type (Visual Basic)When Visual Basic converts Boolean values to numeric types, False becomes 0 and True becomes -1.[/quote ()

т.е. на выходе получаем если ячейка пустая -0, если не пустая --1

Автор - krosav4ig
Дата добавления - 19.03.2019 в 13:40
_Boroda_ Дата: Вторник, 19.03.2019, 14:12 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Андрей, :D если б я не знал о чем речь, то, вот честно, ничего бы не понял
Для таких, как я, которые по пунктам любят, как-то попробую разжевать

Для ActiveSheet
Для первой снизу заполненной ячейки
1. .Value - ее значение
2. IsEmpty(п.1) - если пусто в п.1, то True, иначе - False
3. Not п.2 - наоборот п.2 - True превращаем в False, а False - в True
* Дополнительно - в Excel при арифметических операциях ИСТИНА автоматически преобразуется к 1, а ЛОЖЬ к 0, в VBA все немного не так, там False также преобразуется в 0, а вот True преобразуется в минус единицу
4. Offset(-п.3) - в случае нуля в п.3 никуда не смещается, а в случае True в п.3 смещается на минус минус единицу, то есть на плюс единицу
True в п.3 у нас тогда, когда False в п.2, когда не пусто первое снизу заполненная ячейка. То есть если ячейка заполнена, то уходим вниз на 1, если не заполнена (это может быть только в первой строке), то никуда не уходим, а работаем с этой ячейкой


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеАндрей, :D если б я не знал о чем речь, то, вот честно, ничего бы не понял
Для таких, как я, которые по пунктам любят, как-то попробую разжевать

Для ActiveSheet
Для первой снизу заполненной ячейки
1. .Value - ее значение
2. IsEmpty(п.1) - если пусто в п.1, то True, иначе - False
3. Not п.2 - наоборот п.2 - True превращаем в False, а False - в True
* Дополнительно - в Excel при арифметических операциях ИСТИНА автоматически преобразуется к 1, а ЛОЖЬ к 0, в VBA все немного не так, там False также преобразуется в 0, а вот True преобразуется в минус единицу
4. Offset(-п.3) - в случае нуля в п.3 никуда не смещается, а в случае True в п.3 смещается на минус минус единицу, то есть на плюс единицу
True в п.3 у нас тогда, когда False в п.2, когда не пусто первое снизу заполненная ячейка. То есть если ячейка заполнена, то уходим вниз на 1, если не заполнена (это может быть только в первой строке), то никуда не уходим, а работаем с этой ячейкой

Автор - _Boroda_
Дата добавления - 19.03.2019 в 14:12
t330 Дата: Вторник, 19.03.2019, 15:01 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Спасибо, коллеги!
Все дошло:)
 
Ответить
СообщениеСпасибо, коллеги!
Все дошло:)

Автор - t330
Дата добавления - 19.03.2019 в 15:01
krosav4ig Дата: Вторник, 19.03.2019, 16:10 | Сообщение № 10
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[offtop] :) из меня объясняльщик не очень
чет свой предыдущий пост не могу отредактировать, возвращает 500 ошибку
нада после /url] дописать ]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[offtop] :) из меня объясняльщик не очень
чет свой предыдущий пост не могу отредактировать, возвращает 500 ошибку
нада после /url] дописать ]

Автор - krosav4ig
Дата добавления - 19.03.2019 в 16:10
_Boroda_ Дата: Вторник, 19.03.2019, 16:16 | Сообщение № 11
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У меня тоже. Свой - пожалуйста, твой другой - тоже, а тот - вообще никак, даже пробел добавить не дает


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ меня тоже. Свой - пожалуйста, твой другой - тоже, а тот - вообще никак, даже пробел добавить не дает

Автор - _Boroda_
Дата добавления - 19.03.2019 в 16:16
RAN Дата: Вторник, 19.03.2019, 22:38 | Сообщение № 12
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Так интереснее :)
[vba]
Код
        With ActiveSheet.Cells(Rows.Count, 1).End(xlUp)
            .Offset(-Not IsEmpty(.Value)).Resize(, 2).Value = Array(Image1.Left, Image1.Top)
        End With
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеТак интереснее :)
[vba]
Код
        With ActiveSheet.Cells(Rows.Count, 1).End(xlUp)
            .Offset(-Not IsEmpty(.Value)).Resize(, 2).Value = Array(Image1.Left, Image1.Top)
        End With
[/vba]

Автор - RAN
Дата добавления - 19.03.2019 в 22:38
t330 Дата: Среда, 20.03.2019, 03:17 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Так интереснее


Код конечно короче, но мышка не фокусируется на картинке (см вложе файл)
К сообщению приложен файл: 3097650.xlsm (26.9 Kb)
 
Ответить
Сообщение
Так интереснее


Код конечно короче, но мышка не фокусируется на картинке (см вложе файл)

Автор - t330
Дата добавления - 20.03.2019 в 03:17
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Показать координаты всех перемещений картинки в ЮзерФорме (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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