Как я могу использовать JavaScript в макросе Excel?

Question

Здесь есть действительно классный класс diff, размещенный Google:

http://code.google.com/p/google-diff-match-patch/

Я использовал его раньше на нескольких веб-сайтах, но теперь мне нужно его использовать внутри макрос Excel для сравнения текста между двумя ячейками.

Однако он доступен только в JavaScript, Python, Java и C ++, а не в VBA.

Мои пользователи ограничены Excel 2003, поэтому чистое .СЕТЕВОЕ решение не будет работать.Перевод кода в VBA вручную занял бы слишком много времени и затруднил бы обновление.

Одним из вариантов, который я рассматривал, была компиляция исходного кода JavaScript или Java с использованием .СЕТЕВЫЕ компиляторы (JScript.NET или J #), используйте Reflector для вывода как VB.NET, затем, наконец, обновите VB.NET код вручную до VBA, что даст мне чистое решение на VBA.После того, как возникли проблемы с его компиляцией с помощью любого .NET compiler, я отказался от этого пути.

Предполагая, что я мог бы получить рабочую библиотеку .NET, я мог бы также использовать ExcelDNA (http://www.codeplex.com/exceldna), надстройка Excel с открытым исходным кодом для упрощения .Интеграция с сетевым кодом.

Моей последней идеей было разместить объект Internet Explorer, отправить ему исходный код JavaScript и вызвать его.Даже если бы у меня получилось это сделать, я предполагаю, что это было бы ужасно медленно и грязно.

Обновить:Решение найдено!

Я использовал метод WSC, описанный ниже в принятом ответе.Мне пришлось немного изменить код WSC, чтобы убрать различия и вернуть мне VBA-совместимый массив массивов:

function DiffFast(text1, text2)
{
    var d = dmp.diff_main(text1, text2, true);
    dmp.diff_cleanupSemantic(d);
    var dictionary = new ActiveXObject("Scripting.Dictionary"); // VBA-compatible array
    for ( var i = 0; i < d.length; i++ ) {
    dictionary.add(i, JS2VBArray(d[i]));
    }
    return dictionary.Items();
}

function JS2VBArray(objJSArray)
{
    var dictionary = new ActiveXObject("Scripting.Dictionary");
    for (var i = 0; i < objJSArray.length; i++) {
        dictionary.add( i, objJSArray[ i ] );
        }
    return dictionary.Items();
}

Я зарегистрировал WSC, и это сработало просто отлично.Код в VBA для его вызова выглядит следующим образом:

Public Function GetDiffs(ByVal s1 As String, ByVal s2 As String) As Variant()
    Dim objWMIService As Object
    Dim objDiff As Object
    Set objWMIService = GetObject("winmgmts:")
    Set objDiff = CreateObject("Google.DiffMatchPath.WSC")
    GetDiffs = objDiff.DiffFast(s1, s2)
    Set objDiff = Nothing
    Set objWMIService = Nothing
End Function

(Я попытался сохранить единый глобальный objWMIService и objDiff, чтобы мне не приходилось создавать / уничтожать их для каждой ячейки, но, похоже, это не повлияло на производительность.)

Затем я написал свой основной макрос.Для этого требуется три параметра:диапазон (один столбец) исходных значений, диапазон новых значений и диапазон, в котором diff должен выводить результаты.Все они предполагаемый чтобы иметь одинаковое количество строк, у меня здесь не происходит какой-либо серьезной проверки ошибок.

Public Sub DiffAndFormat(ByRef OriginalRange As Range, ByRef NewRange As Range, ByRef DeltaRange As Range)
    Dim idiff As Long
    Dim thisDiff() As Variant
    Dim diffop As String
    Dim difftext As String
    difftext = ""
    Dim diffs() As Variant
    Dim OriginalValue As String
    Dim NewValue As String
    Dim DeltaCell As Range
    Dim row As Integer
    Dim CalcMode As Integer

Эти следующие три строки ускоряют обновление, не нарушая предпочтительный режим расчета пользователя позже:

    Application.ScreenUpdating = False
    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    For row = 1 To OriginalRange.Rows.Count
        difftext = ""
        OriginalValue = OriginalRange.Cells(row, 1).Value
        NewValue = NewRange.Cells(row, 1).Value
        Set DeltaCell = DeltaRange.Cells(row, 1)
        If OriginalValue = "" And NewValue = "" Then

Важно стереть предыдущие различия, если таковые имеются:

            Erase diffs

Этот тест представляет собой визуальный ярлык для моих пользователей, поэтому становится ясно, когда никаких изменений вообще нет:

        ElseIf OriginalValue = NewValue Then
            difftext = "No change."
            Erase diffs
        Else

Объедините весь текст вместе в качестве значения дельта-ячейки, независимо от того, был ли текст идентичным, вставленным или удаленным:

            diffs = GetDiffs(OriginalValue, NewValue)
            For idiff = 0 To UBound(diffs)
                thisDiff = diffs(idiff)
                difftext = difftext & thisDiff(1)
            Next
        End If

Вы должны установить значение до того , как запуск форматирования:

        DeltaCell.value2 = difftext
        Call FormatDiff(diffs, DeltaCell)
    Next
    Application.ScreenUpdating = True
    Application.Calculation = CalcMode
End Sub

Вот код, который интерпретирует различия и форматирует дельта-ячейку:

Public Sub FormatDiff(ByRef diffs() As Variant, ByVal cell As Range)
    Dim idiff As Long
    Dim thisDiff() As Variant
    Dim diffop As String
    Dim difftext As String
    cell.Font.Strikethrough = False
    cell.Font.ColorIndex = 0
    cell.Font.Bold = False
    If Not diffs Then Exit Sub
    Dim lastlen As Long
    Dim thislen As Long
    lastlen = 1
    For idiff = 0 To UBound(diffs)
        thisDiff = diffs(idiff)
        diffop = thisDiff(0)
        thislen = Len(thisDiff(1))
        Select Case diffop
            Case -1
                cell.Characters(lastlen, thislen).Font.Strikethrough = True
                cell.Characters(lastlen, thislen).Font.ColorIndex = 16 ' Dark Gray http://www.microsoft.com/technet/scriptcenter/resources/officetips/mar05/tips0329.mspx
            Case 1
                cell.Characters(lastlen, thislen).Font.Bold = True
                cell.Characters(lastlen, thislen).Font.ColorIndex = 32 ' Blue
        End Select
        lastlen = lastlen + thislen
    Next
End Sub

Есть некоторые возможности для оптимизации, но пока все работает просто отлично.Спасибо всем, кто помог!

Answer 1

Самым простым подходом может быть внедрение логики Javascript diff в COM-компонент непосредственно с использованием Javascript.Это возможно с помощью чего-то, называемого "Компоненты скрипта Windows".

Вот учебное пособие по созданию WSCS.

Компонент сценария Windows - это COM-компонент, который определен в script.Интерфейс к компоненту осуществляется через COM, что означает, что он совместим с VBA.Логика реализована на любом языке, совместимом с хостингом сценариев Windows, таком как JavaScript или VBScript.WSC определяется в одном XML-файле, который включает логику, идентификатор класса компонента, методы, логику регистрации и так далее.

Там также есть доступный инструмент, помогающий в создании WSC.По сути, это устройство типа мастера, которое задает вам вопросы и заполняет XML-шаблон.Сам я просто начал с файла example .wsc и отредактировал его вручную с помощью текстового редактора.Это говорит само за себя.

COM-компонент, определенный таким образом в script (в файле .wsc), вызывается точно так же, как и любой другой COM-компонент, из любой среды, которая может взаимодействовать с COM.

Обновить:Я потратил несколько минут и подготовил WSC для GoogleDiff.Вот оно.

<?xml version="1.0"?>

<package>

<component id="Cheeso.Google.DiffMatchPatch">

  <comment>
    COM Wrapper on the Diff/Match/Patch logic published by Google at http://code.google.com/p/google-diff-match-patch/.
  </comment>

<?component error="true" debug="true"?>

<registration
  description="WSC Component for Google Diff/Match/Patch"
  progid="Cheeso.Google.DiffMatchPatch"
  version="1.00"
  classid="{36e400d0-32f7-4778-a521-2a5e1dd7d11c}"
  remotable="False">

  <script language="VBScript">
  <![CDATA[

    strComponent = "Cheeso's COM wrapper for Google Diff/Match/Patch"

    Function Register
      MsgBox strComponent & " - registered."
    End Function

    Function Unregister
      MsgBox strComponent & " - unregistered."
    End Function

  ]]>
  </script>
</registration>


<public>
  <method name="Diff">
    <parameter name="text1"/>
    <parameter name="text2"/>
  </method>
  <method name="DiffFast">
    <parameter name="text1"/>
    <parameter name="text2"/>
  </method>
</public>


<script language="Javascript">
<![CDATA[


    // insert original google diff code here...


// public methods on the component
var dpm = new diff_match_patch();


function Diff(text1, text2)
{
   return dpm.diff_main(text1, text2, false);
}


function DiffFast(text1, text2)
{
   return dpm.diff_main(text1, text2, true);
}


]]>
</script>

</component>

</package>

Чтобы использовать эту штуку, вы должны зарегистрировать ее.В Проводнике щелкните по нему правой кнопкой мыши и выберите "Зарегистрироваться".или из командной строки:файл regsvr32:\c:\scripts\GoogleDiff.wsc

Я не пробовал использовать его из VBA, но вот некоторый код VBScript, который использует этот компонент.

Sub TestDiff()
    dim t1 
    t1 = "The quick brown fox jumped over the lazy dog."

    dim t2 
    t2 = "The large fat elephant jumped over the cowering flea."

    WScript.echo("")

    WScript.echo("Instantiating a Diff Component ...")
    dim d
    set d = WScript.CreateObject("Cheeso.Google.DiffMatchPatch")

    WScript.echo("Doing the Diff...")
    x = d.Diff(t1, t2)

    WScript.echo("")
    WScript.echo("Result was of type: " & TypeName(x))
    ' result is all the diffs, joined by commas.  
    ' Each diff is an integer (position), and a string.  These are separated by commas.
    WScript.echo("Result : " & x)

    WScript.echo("Transform result...")
    z= Split(x, ",")
    WScript.echo("")
    redim diffs(ubound(z)/2)
    i = 0
    j = 0
    For Each item in z
      If (j = 0) then
        diffs(i) = item
        j = j+ 1      
      Else 
          diffs(i) = diffs(i) & "," & item
        i = i + 1
        j = 0
      End If
    Next

    WScript.echo("Results:")
    For Each item in diffs
      WScript.echo("  " & item)
    Next

    WScript.echo("Done.")

End Sub

Answer 2

В Движок сценариев Windows позволит вам запустить библиотеку JavaScript.По моему опыту, это хорошо работает.

Answer 3

Мое предложение состояло бы в том, что бы вы ни делали, вы оборачиваете это в COM-оболочку.VBA лучше всего справляется с COM-объектами, поэтому вы можете скомпилировать их как компонент .NET, а затем предоставить как COM-объект, используя функциональность взаимодействия .NET.

В качестве альтернативы вы также могли бы рассмотреть возможность использования объектов Windows Scripting Host objects для выполнения файла Javascript и возврата вам результата.

Answer 4

Вот еще один вариант для рассмотрения, хотя я ни в коем случае не утверждаю, что он лучший.

• Убедитесь, что версия Python компилируется в IronPython.(Здесь не должно быть никаких проблем или, самое большее, потребуется лишь небольшое количество портирования.)
• Создайте библиотеку надстроек Excel, используя C #, и ссылайтесь на IronPython из нее.
• Оберните необходимую функциональность в вашу надстройку C # Excel.