Полезные Excel Макросы

Предисловие

Вы можете свободно применять следующие примеры макросов в ваших Excel-приложениях. Эти макросы представляют простые процедуры и полезные подсказки, которые вы можете использовать, чтобы создать интерактивные Excel-приложения для чтения и записи данных в DataHub.

Познакомьтесь с возможностями подключения DataHub к Excel

Введение

Эти Excel Макросы основаны на таблице данных, состоящей из 100 строк и 40 столбцов (начиная с ячейки А1) и расположенной в Лист1 (Sheet1) рабочей таблицы. Мы постарались создать унифицированные макросы, которые вы сможете легко настроить под свои нужды.

Макросы, которые помогут настроить Excel для чтения данных из DataHub (используется DDEAdvise)

1. Макрос включает массивы данных из DataHub в таблицу значений Excel, по одному массиву на строку.

Зачастую большие наборы данных более удобно передавать в виде массива, поскольку это существенно снижает требования к пропускной способности и увеличивает скорость передачи. Этот макрос настраивает циклы DDEAdvise от DataHub к Excel так, что каждая строка таблицы связана со значением массива в DataHub. Как правило, вам нужно запустить этот макрос только один раз — при настройке электронной таблицы.

Каждое значение данных, представляющее строку данных, поименовано, как "array0001", "array0002" и т.д.

---------  Add to Sheet 1 Macro Code  -------------
Sub register_arrays()
    Dim pname As String
    
    For i = 1 To 100
        pname = Format(i, "0000")
        pname = "=datahub|default!array" & pname
        Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 40)).FormulaArray = pname
    Next i
End Sub
---------------------------------------------------

2. Включает отдельные значения данных из DataHub в таблицу значений, по одному значению на ячейку.

Этот макрос настраивает циклы DDEAdvise от DataHub к Excel так, что каждая ячейка таблицы связана со значением метки в DataHub. Как правило, вам нужно запустить этот макрос только один раз — при настройке электронной таблицы.

Каждое значение данных метки поименовано, как "point0001", "point0002" и т.д.

---------  Add to Sheet 1 Macro Code  -------------
Sub register_points()
    Dim pname As String
    
    For i = 1 To 100
        For j = 1 To 40
            pname = Format((i - 1) * 40 + j, "0000")
            pname = "=datahub|default!point" & pname
            Worksheets("Sheet1").Cells(i, j).Formula = pname
        Next j
    Next i
End Sub
---------------------------------------------------

Макросы для записи данных из Excel – Запись инициируется по запросу пользователя (используется DDEPoke)

Следующие макросы полезны для записи данных из Excel по запросу, другими словами, пользователь решает, когда записывать данные, и инициирует запись путем запуска одного из этих макросов (обычно щелчком по определенной кнопке).

3. Передает массив данных позициям в DataHub, по одному массиву на строку.

Этот макрос будет запускаться каждый раз, когда вы хотите записать данные из таблицы Excel в DataHub. Этот макрос будет записывать каждую строку таблицы как значение массива в DataHub. Макрос передает все строки таблицы, одну за другой.

Каждое значение данных, представляющее строку данных, поименовано, как "array0001", "array0002" и т.д.

---------  Add to Sheet 1 Macro Code  -------------
Sub transmit_arrays()
    Dim chan As Integer
    Dim pname As String

    chan = DDEInitiate("datahub", "default")
    For i = 1 To 100
        pname = Format(i, "0000")
        pname = "array" & pname
        DDEPoke chan, pname, Worksheets("Sheet1").Range(Cells(i, 1), Cells(i, 40))
    Next i
    DDETerminate (chan)
End Sub
---------------------------------------------------

4. Передает отдельные значения данных позициям в DataHub, по одному значению на ячейку.

Этот макрос будет запускаться каждый раз, когда вы хотите записать данные из таблицы Excel в DataHub. Этот макрос будет записывать каждую ячейку таблицы в отдельную позицию DataHub. Макрос передает все ячейки таблицы, одну за другой.

Каждое значение данных метки поименовано, как "point0001", "point0002" и т.д.

---------  Add to Sheet 1 Macro Code  -------------
Sub transmit_points()
    Dim chan As Integer
    Dim pname As String

    chan = DDEInitiate("datahub", "default")
    For i = 1 To 100
        For j = 1 To 40
            pname = Format((i - 1) * 40 + j, "0000")
            pname = "point" & pname
            DDEPoke chan, pname, Worksheets("Sheet1").Cells(i, j)
        Next j
    Next i
    DDETerminate (chan)
End Sub
---------------------------------------------------

Макросы для записи данных из Excel – Автоматическая запись при изменении значения (используется DDEPoke)

Следующие макросы могут быть полезны для автоматической передачи данных из Excel в DataHub.

5. Каждый раз, когда пользователь вводит новое значение, проверяет, поименована ли ячейка. Если да, новое значение передается позиции DataHub с тем же именем.

Имя подпрограммы "Worksheet_Change" является специальным - Excel вызывает ее каждый раз, когда в таблице (Worksheet) появляется изменение, будь то пользовательский ввод или пересчет (но кроме изменений, вызванных сообщением DDE, см. №7 ниже).

---------  Add to Sheet 1 Macro Code  -------------
Sub Worksheet_Change(ByVal Target As Range)
    Dim rname As String
    Dim channel As Variant
    
    On Error Resume Next
    rname = Target.name.name
    If Not rname = "" Then
        channel = DDEInitiate("datahub", "default")
        DDEPoke channel, rname, Target
        DDETerminate (channel)
    End If
End Sub
---------------------------------------------------

6. Определяет, когда ячейка из диапазона, поименованного определенным образом, изменилась посредством пользовательского ввода, и передает содержимое диапазона DataHub.

Этот макрос полезен, поскольку нет необходимости настраивать каждую ячейку, значение которой необходимо записывать в DataHub. Если изменившаяся ячейка из определенного диапазона, все значения данного диапазона автоматически записываются в DataHub.

Эта программа выявляет диапазон, включающий изменения, и если диапазон подходит под один из заранее определенных, отправляет диапазон DataHub. Функция извлекает имя диапазона ячеек, пересекающегося с заданным диапазоном. Если больше одного диапазона в таблице пересекаются с заданным диапазоном, возвращается первый.

--------  Add to Workbook Macro Code  -------------
Function NameOfParentRange(Rng As Range) As String
    Dim Nm As Name
    For Each Nm In ThisWorkbook.Names
        If Rng.Parent.Name = Nm.RefersToRange.Parent.Name Then
            If Not Application.Intersect(Rng, Nm.RefersToRange) Is Nothing Then
                NameOfParentRange = Nm.Name
                Exit Function
            End If
        End If
    Next Nm
    NameOfParentRange = ""
End Function

---------  Add to Sheet 1 Macro Code  -------------
Sub Worksheet_Change(ByVal r As Range)
    Dim pname As String
    Dim chan As Integer

    pname = ThisWorkbook.NameOfParentRange(r)
    If Not pname = "" Then
        On Error Resume Next
        chan = DDEInitiate("datahub", "default")
        DDEPoke chan, pname, Worksheets("Sheet1").Range(pname)
        DDETerminate (chan)
    End If
End Sub
---------------------------------------------------

Другие полезные Excel Макросы

7. Инициирует вызов макроса при получении сообщения DDE для определенной позиции.

Следующие два макроса иллюстрируют, как настроить связь так, чтобы макрос запускался каждый раз, когда значение ячейки обновляется сообщением DDE. В примере ниже мы исходим из того, что в ячейку внесено обновленное значение из DataHub. Мы определяем связь так, чтобы макрос запускался при каждом обновлении значения метки.

Допустим, что point0001 обновляется посредством ссылки DDEAdvise из DataHub.
Макрос set_link создает связь между позицией DataHub point0001 и макросом link_updated. Макрос link_updated() просто увеличивает значение в ячейке А1 на 1. Вам нужно только единожды запустить макрос set_link (возможно, когда лист загружен) для установления связи. Всякий раз, когда ячейка, содержащая point0001, обновляется DataHub, макрос link_updated будет запускаться и значение в Cell (1,1) будет увеличено на 1.

---------  Add to Sheet 1 Macro Code  -------------
Sub link_updated()
    Cells(1, 1) = Cells(1, 1) + 1
End Sub

--------  Run once to establish link  -------------
Sub set_link()
    ThisWorkbook.SetLinkOnData "datahub|default!'point0001'", "Sheet1.link_updated"
End Sub
---------------------------------------------------