VBA для MS EXCEL есть проблема с макросом

Одиночка · 06 ноя 2008, 18:32

По протоколу DDE из другого приложения импортируются котировки валют в MS Excel? Имеется таблица 7 столбцов и 5 строк в MS Excel? В ячейке С6 постоянно меняется цифра, которая выглядит как 1.2827 (например). Т.е. целая и дробная часть (4 знака после точки) и дробная часть от целой отделяется не запятой, а точкой. Я хочу, чтобы в ячейке J6 производилось вычисление =С6-0.0005 и полученный результат сразу копировался в буфер обмена. Так как число в ячейке С6 постоянно меняется, то результат в ячейке J6 тоже должен постоянно и синхронно изменяться. При каждом таком изменении:
1. БУФЕР ОБМЕНА ДОЛЖЕН ОЧИЩАТЬСЯ и
2. В буфер копировалось новое значение ячейки J6.

Написали макрос, вот он:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MyData As DataObject

Set MyData = New DataObject

Application.DecimalSeparator = "."
Application.UseSystemSeparators = False

Cells(6, 10).FormulaR1C1 = "=RC[-7]-0.0005"
MyData.SetText Cells(6, 10)
MyData.PutInClipboard
End Sub

НО!!!!
НЕ получается следующего результата:
Т.е. MS Excel свернут, а в любом приложении в Windows, где стоит курсор, нажав Ctrl+V вставилась свежая цифра С6-0.0005
А получается с этим макросом следующее:
Располагаем рядом MS Word и MS Excel на мониторе, работаем с MS Word. Активен MS Word, Нажимаем Ctrl+V, вставляется цифра из ячейки J6. Видим, что в этой ячейке не активного MS Excel значение изменилось. В надежде, что в буфере уже обновленное число содержится, нажимаем в MS Word Ctrl+V, а число вставляется точно то же, что вставилось в первый раз. Хотя должно было вставиться уже другое. Далее если тыкнуть мышью на листе MS Excel в любую ячейку, пустую или не пустую, просто совсем любую, сразу происходят изменения в буфере обмена и в буфере появляется текущее значение ячейки J6. Если не делать такого действия, буфер обмена не изменяется.
А нужно, чтобы изменения шли постоянно и непрерывно, независимо от того, активен в данный момент MS Excel или нет.
Т.е мне нужно, чтобы от числа, которое приходит по протоколу DDE из другого приложения в MS Excel вычиталась цифра 0.0005, по формуле (=С6-0.0005), динамически пересчитывалось по этой формуле, как только исходное число изменилось. Эти вычисления производились в ячейке J6. И в каждом случае, когда результат изменился, этот результат копировался в буфер обмена, и буфер обмена перед этим копированием очищался. И этот процесс шел автоматом и без остановок и скопированный результат был абсолютно всегда доступен в любом приложении Windows при нажатии клавиш Ctrl+V.

EducatedFool · 06 ноя 2008, 19:19

Используйте таймер для копирования в буфер обмена:

Код: Выделить всё

Sub Main()
    Application.DecimalSeparator = "."
    Application.UseSystemSeparators = False
    Timer
End Sub

Sub Timer()
    Cells(6, 10).FormulaR1C1 = "=RC[-7]-0.0005"
    SetClipboard Cells(6, 10).Value
    Application.OnTime Now + TimeValue("[B]00:00:02[/B]"), "Timer"
End Sub

Public Sub SetClipboard(Obj As Variant)
    Dim MyDataObj As New DataObject
    MyDataObj.SetText CStr(Obj)
    MyDataObj.PutInClipboard: Set MyDataObj = Nothing
End Sub

Запустите один раз макрос Main
Время обновления буфера обмена в приведённом коде - 2 секунды.

Naeel Maqsudov · 06 ноя 2008, 22:29

1)
SelectionChange происходит тогда, когда изменяется выделение, т.е. перемещается табличный курсор по рабочему листу.
Worksheet_Change происходит при изменении данных, но его надо ловить на ячейке C6, так как J6 хоть и показывает новое значение, но на самом-то деле ячейка не изменилась! Там же формула, а формула не претерпела изменений, просто показывает новый результат. Т.е. что-то типа

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$C$6" Then
    'Что-то, что выполняется при получении новых данных по DDE
  End If
End Sub

2)
Изменение значения в буфере обмена произойдет только 1 раз, при получении данных, но буфером пользователь может пользоваться и для копирования файлов, и для копирования другого текста и бог еще знает для чего. Поэтому буфер обмена - это не очень хороший инструмент для передачи данных в приложение. Если Вам надо ограничиться только Word-ом, то надо подумать, как эту задачу решить исключительно для Word-а. Если вставка нужна в любые приложения, то я тоже поискал бы другой путь. Но работать за компьтером, на котором непредсказуемо (по таймеру) сбрасывается значение буфера, где находятся, скажем вырезанные где-то данные я бы не хотел

Просто счел бы за издевательство.
Будем искать другие пути?

Aent · 07 ноя 2008, 00:37

Да. Использовать здесь Excel и стандартный Clipboard явно попытка с негодными средствами.
IMHO лучше посмотреть в сторону AutoHotkey.(http://www.script-coding.info/AutoHotke ... ation.html )
Посмотрите http://www.script-coding.info/index.html
И особенно Серый форум

Одиночка · 07 ноя 2008, 15:22

Naeel Maqsudov писал(а):1)
Worksheet_Change происходит при изменении данных, но его надо ловить на ячейке C6, так как J6 хоть и показывает новое значение, но на самом-то деле ячейка не изменилась! Там же формула, а формула не претерпела изменений, просто показывает новый результат. Т.е. что-то типа
Код: Выделить всё
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$C$6" Then
    'Что-то, что выполняется при получении новых данных по DDE
  End If
End Sub
2)
Будем искать другие пути?

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

Одиночка · 07 ноя 2008, 16:55

Похоже. что макрос не улавливает котировки по DDE, там данные идут с точкой вместо запятой, вот он и не реагирует. Возможно нужно результат из ячейки J6 вначале вставлять в какую нибудь одну ячейку, например J7. Но, чтобы вставляемое число вставлялось в ячейку уже с запятой вместо точки. А затем следить за изменением этой ячейки J7. И когда в J7 число изменилось, этот результат отправлять в буфер.

Одиночка · 07 ноя 2008, 17:21

EducatedFool писал(а):Используйте таймер для копирования в буфер обмена:
Код: Выделить всё
Sub Main()
    Application.DecimalSeparator = "."
    Application.UseSystemSeparators = False
    Timer
End Sub

Sub Timer()
    Cells(6, 10).FormulaR1C1 = "=RC[-7]-0.0005"
    SetClipboard Cells(6, 10).Value
    Application.OnTime Now + TimeValue("[B]00:00:02[/B]"), "Timer"
End Sub

Public Sub SetClipboard(Obj As Variant)
    Dim MyDataObj As New DataObject
    MyDataObj.SetText CStr(Obj)
    MyDataObj.PutInClipboard: Set MyDataObj = Nothing
End Sub
Запустите один раз макрос Main
Время обновления буфера обмена в приведённом коде - 2 секунды.

При компиляции такого макроса ругается на строку Public Sub SetClipboard
Выдает сообщение User-defined type not defined (Определенный пользователем тип, не определенный)
Версия MS Excel 2003 (11.5612.5606)

EducatedFool · 07 ноя 2008, 18:10

Выдает сообщение User-defined type not defined

Ругается, скорее всего, на строку Dim MyDataObj As New DataObject...

Для работы этого кода необходимо подключить библиотеку Microsoft Forms 2.0 Object Library.
Чтобы её поключить, в меню Tools - References... поставьте галочку напротив строки Microsoft Forms 2.0 Object Library и нажмите OK.

Одиночка · 07 ноя 2008, 18:28

EducatedFool писал(а):Ругается, скорее всего, на строку Dim MyDataObj As New DataObject...

Для работы этого кода необходимо подключить библиотеку Microsoft Forms 2.0 Object Library.
Чтобы её поключить, в меню Tools - References... поставьте галочку напротив строки Microsoft Forms 2.0 Object Library и нажмите OK.

Спасибо, так все заработало.
Может в этом меню везде галки поставить, чтобы у меня больше таких вопросов не возникало, или не стоит?
А можно выставить обновление буфера меньше 1 секунды?
А так все работает.

EducatedFool · 07 ноя 2008, 18:43

Может в этом меню везде галки поставить, чтобы у меня больше таких вопросов не возникало, или не стоит?

Вот этого точно делать не стоит...

А можно выставить обновление буфера меньше 1 секунды?

При желании можно всё...

В Вашем случае можно использовать и такой код:

Код: Выделить всё

Sub Main()
    Application.DecimalSeparator = "."
    Application.UseSystemSeparators = False
    Do
        Cells(6, 10).FormulaR1C1 = "=RC[-7]-0.0005": DoEvents
        SetClipboard Cells(6, 10).Value: DoEvents:
        'i = i + 1:Application.StatusBar = i
    Loop
End Sub

Public Sub SetClipboard(Obj As Variant)
    Dim MyDataObj As New DataObject
    MyDataObj.SetText CStr(Obj)
    MyDataObj.PutInClipboard: Set MyDataObj = Nothing
End Sub

Он будет выполнять те же действия несколько сотен раз в секунду.