如何在Excel宏中使用JavaScript？

时间：2009-05-11 14:01:10

标签： .net javascript excel vba j#

谷歌有一个非常酷的差异类：

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

我以前在几个网站上使用过它，但现在我需要在 Excel宏中使用来比较两个单元格之间的文本。

但是，它仅适用于JavaScript，Python，Java和C ++，而不适用于VBA。

我的用户仅限于Excel 2003，因此纯.NET解决方案无效。手动将代码翻译为VBA会花费太多时间并且难以升级。

我考虑的一个选项是使用.NET编译器（JScript.NET或J＃）编译JavaScript或Java源代码，使用Reflector输出为VB.NET，然后最终手动将VB.NET代码降级为VBA，我是一个纯粹的VBA解决方案。在使用任何.NET编译器进行编译时遇到问题后，我放弃了这条路径。

假设我可以使用一个可用的.NET库，我本可以使用ExcelDna（http://www.codeplex.com/exceldna），一个开源Excel插件，使.NET代码集成更容易。

我的最后一个想法是托管一个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

将所有文本合并为delta单元格值，文本是否相同，插入或删除：

            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

这是解释差异并格式化delta单元格的代码：

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

有一些优化的机会，但到目前为止，它的工作正常。感谢所有帮助过的人！

4 个答案:

答案 0 :(得分：12)

最简单的方法可能是使用Javascript直接将Javascript diff逻辑嵌入到COM组件中。这可以通过名为“Windows Script Components”的东西来实现。

这是a tutorial on creating WSCs。

Windows脚本组件是在脚本中定义的COM组件。组件的接口是通过COM，这意味着它是VBA友好的。该逻辑在任何与Windows Scripting Hosting兼容的语言（如JavaScript或VBScript）中实现。 WSC在单个XML文件中定义，该文件嵌入逻辑，组件类ID，方法，注册逻辑等。

还有tool available to help in creating a WSC。基本上它是一个向导类型的东西，它会向您询问问题并填写XML模板。我自己，我刚开始使用示例.wsc文件并使用文本编辑器手动编辑。这是不言自明的。

在脚本中（在.wsc文件中）以这种方式定义的COM组件可以像任何其他COM组件一样从任何可以与COM共舞的环境中调用。

更新：我花了几分钟时间为GoogleDiff制作了WSC。在这里。

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

答案 1 :(得分：4)

Windows Scripting Engine将允许您运行JavaScript库。它在我的经验中运作良好。

答案 2 :(得分：2)

我的建议是，无论你做什么，你都将它包装在一个COM包装器中。 VBA最好地处理COM对象，因此您可以编译为.NET组件，然后使用.NET的互操作功能将其公开为COM对象。

作为替代方案，您还可以考虑使用Windows Scripting Host对象来执行Javascript文件并返回结果。

答案 3 :(得分：1)

这是另一个需要考虑的选择，尽管我并不是说它是最好的选择。

  • 确保Python版本在IronPython中编译。 （这里不应该有任何问题，或者最多只能进行少量移植。）
  • 使用C＃创建Excel加载项库并从中引用IronPython。
  • 在C＃Excel加载项中包含必要的功能。
相关问题
最新问题