Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
265 views
in Technique[技术] by (71.8m points)

.net - How can I use JavaScript within an Excel macro?

There’s a really cool diff class hosted by Google here:

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

I’ve used it before on a few web sites, but now I need to use it within an Excel macro to compare text between two cells.

However, it is only available in JavaScript, Python, Java, and C++, not VBA.

My users are limited to Excel 2003, so a pure .NET solution wouldn't work. Translating the code to VBA manually would take too much time and make upgrading difficult.

One option I considered was to compile the JavaScript or Java source using the .NET compilers (JScript.NET or J#), use Reflector to output as VB.NET, then finally downgrade the VB.NET code manually to VBA, giving me a pure VBA solution. After having problems getting it to compile with any .NET compiler, I abandoned this path.

Assuming I could have gotten a working .NET library, I could have also used ExcelDna (http://www.codeplex.com/exceldna), an open-source Excel add-in to make .NET code integration easier.

My last idea was to host an Internet Explorer object, send it the JavaScript source, and calling it. Even if I got this to work, my guess is it would be dirt-slow and messy.

UPDATE: Solution found!

I used the WSC method described below by the accepted answer. I had to change the WSC code a little to clean up the diffs and give me back a VBA-compatible array of arrays:

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();
}

I registered the WSC and it worked just fine. The code in VBA for calling it is as follows:

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

(I tried keeping a single global objWMIService and objDiff around so I wouldn't have to create/destroy these for each cell, but it didn't seem to make a difference on performance.)

I then wrote my main macro. It takes three parameters: a range (one column) of original values, a range of new values, and a range where the diff should dump the results. All are assumed to have the same number of row, I don't have any serious error-checking going on here.

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

These next three lines speed up the update without botching the user's preferred calculation mode later:

    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

Erasing the previous diffs, if any, is important:

            Erase diffs

This test is a visual shortcut for my users so it's clear when there's no change at all:

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

Combine all the text together as the delta cell value, whether the text was identical, inserted, or deleted:

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

You have to set the value before starting the formatting:

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

Here's the code that interprets the diffs and formats the delta cell:

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

There are some opportunities for optimization, but so far it's working just fine. Thanks to everyone who helped!

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

The simplest approach may be to embed the Javascript diff logic into a COM component directly using Javascript. This is possible via something called "Windows Script Components".

Here's a tutorial on creating WSCs.

A Windows Script Component is a COM component that is defined in script. The interface to the component is via COM, which means it is VBA friendly. The logic is implemented in any Windows Scripting Hosting -compatible language, like JavaScript or VBScript. The WSC is defined in a single XML file, which embeds the logic, the component Class ID, the methods, the registration logic, and so on.

There's also a tool available to help in creating a WSC. Basically it is a wizard-type thing that asks you questions and fills in the XML template. Myself, I just started with an example .wsc file and edited it by hand with a text editor. It's pretty self-explanatory.

A COM component defined this way in script (in a .wsc file) is callable just like any other COM component, from any environment that can dance with COM.

UPDATE: I took a few minutes and produced the WSC for GoogleDiff. Here it is.

<?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>

To use that thing, you have to register it. In Explorer, right click on it, and select "Register". or, from the command line: regsvr32 file:c:scriptsGoogleDiff.wsc

I didn't try using it from VBA, but here is some VBScript code that uses the component.

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...