另辟蹊径--VS2017自定义Excel函数（须安装NET4.0以上版本）

774115495

开发环境 VS2017+OFFice2010
系统 WIN 7 SP1
开发语言VB.net
采用类库开发Excel函数，采用接口的方式，与其他的开发模式不同，这种方法可以屏蔽某些不必要的函数。
注意事项：勾选com互操作。

Imports System.Runtime.InteropServices
Imports System.Reflection
Imports Microsoft.Win32
Imports ExcelFunction

<Guid("68559C01-F472-44A6-AB60-F7DBD7791488")>
Public Interface IFunctions
    '定义函数名 有多少个函数就定义多少个接口
    Function Add(x As Double, y As Double) As Double

End Interface
<Guid("512121D6-F6C4-4570-AEA9-9C3D98F9D3A4"),
    ProgId("ExcelFunction.UDF"),
    '更改类名
    ClassInterface(ClassInterfaceType.AutoDual),
    ComDefaultInterface(GetType(IFunctions))>
Public Class UDF
    '导入接口函数
    Implements IFunctions

    <ComRegisterFunction>
    Public Shared Sub RegisterFunction(type As Type)
        Dim PATH As String = System.Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase.Replace("\", "/")
        Dim ASSM As String = Assembly.GetExecutingAssembly().FullName
        Dim startPos As Integer = ASSM.ToLower().IndexOf("version=") + "version=".Length
        Dim len As Integer = ASSM.ToLower().IndexOf(",", startPos) - startPos
        Dim VER As String = ASSM.Substring(startPos, len)
        Dim GUID As String = "{" + type.GUID.ToString().ToUpper() + "}"
        Dim NAME As String = type.[Namespace] + "." + type.Name
        Dim BASE As String = Convert.ToString("Classes\") & NAME
        Dim CLSID As String = Convert.ToString("Classes\CLSID\") & GUID
        Dim CU As RegistryKey = Registry.CurrentUser.OpenSubKey("Software", True)
        Dim key As RegistryKey = CU.OpenSubKey(Convert.ToString(CLSID & Convert.ToString("\InprocServer32\")) & VER)
        If key Is Nothing Then
            key = CU.CreateSubKey(BASE)
            key.SetValue("", NAME)
            key = CU.CreateSubKey(BASE & Convert.ToString("\CLSID"))
            key.SetValue("", GUID)
            key = CU.CreateSubKey(CLSID)
            key.SetValue("", NAME)
            key = CU.CreateSubKey(CLSID & Convert.ToString("\Implemented Categories")).CreateSubKey("{62C8FE65-4EBB-45e7-B440-6E39B2CDBF29}")
            key = CU.CreateSubKey(CLSID & Convert.ToString("\InprocServer32"))
            key.SetValue("", Environment.SystemDirectory + "\mscoree.dll")
            key.SetValue("ThreadingModel", "Both")
            key.SetValue("Class", NAME)
            key.SetValue("CodeBase", PATH)
            key.SetValue("Assembly", ASSM)
            key.SetValue("RuntimeVersion", "v4.0.30319")
            key = CU.CreateSubKey(Convert.ToString(CLSID & Convert.ToString("\InprocServer32\")) & VER)
            key.SetValue("Class", NAME)
            key.SetValue("CodeBase", PATH)
            key.SetValue("Assembly", ASSM)
            key.SetValue("RuntimeVersion", "v4.0.30319")
            key = CU.CreateSubKey(CLSID & Convert.ToString("\ProgId"))
            key.SetValue("", NAME)
            key = CU.CreateSubKey(CLSID & Convert.ToString("\Programmable"))
            For Each keyName As String In Registry.CurrentUser.OpenSubKey("Software\Microsoft\Office\").GetSubKeyNames()
                If IsVersionNum(keyName) Then
                    key = Registry.CurrentUser.OpenSubKey((Convert.ToString("Software\Microsoft\Office\") & keyName) + "\Excel\Add-in Manager", True)
                    If key IsNot Nothing Then
                        key.SetValue(NAME, "")
                    End If
                End If
            Next
        End If
    End Sub
    <ComUnregisterFunctionAttribute>
    Public Shared Sub UnregisterFunction(type As Type)
        Dim GUID As String = "{" + type.GUID.ToString().ToUpper() + "}"
        Dim NAME As String = type.[Namespace] + "." + type.Name
        Dim BASE As String = Convert.ToString("Classes\") & NAME
        Dim CLSID As String = Convert.ToString("Classes\CLSID\") & GUID
        Dim CU As RegistryKey = Registry.CurrentUser.OpenSubKey("Software", True)
        Try
            CU.DeleteSubKeyTree(BASE)
        Catch
        End Try
        Try
            CU.DeleteSubKeyTree(CLSID)
        Catch
        End Try
        For Each keyName As String In Registry.CurrentUser.OpenSubKey("Software\Microsoft\Office\").GetSubKeyNames()
            If IsVersionNum(keyName) Then
                Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey((Convert.ToString("Software\Microsoft\Office\") & keyName) + "\Excel\Add-in Manager", True)
                If key IsNot Nothing Then
                    Try
                        key.DeleteValue(NAME)
                    Catch
                    End Try
                End If
                key = Registry.CurrentUser.OpenSubKey((Convert.ToString("Software\Microsoft\Office\") & keyName) + "\Excel\Options", True)
                If key Is Nothing Then
                    Continue For
                End If
                For Each valueName As String In key.GetValueNames()
                    If valueName.StartsWith("OPEN") Then
                        If key.GetValue(valueName).ToString().Contains(NAME) Then
                            Try
                                key.DeleteValue(valueName)
                            Catch
                            End Try
                        End If
                    End If
                Next
            End If
        Next
    End Sub
    Public Shared Function IsVersionNum(s As String) As Boolean
        Dim idx As Integer = s.IndexOf(".")
        If idx >= 0 AndAlso s.EndsWith("0") AndAlso Integer.Parse(s.Substring(0, idx)) > 0 Then
            Return True
        Else
            Return False
        End If
    End Function
    '写接口函数
    Public Function Add(x As Double, y As Double) As Double Implements IFunctions.Add
        Return x + y
    End Function
End Class

minren118

这种方式开发出来的，估计需要用户有管理员权限来注册才能使用，轮子世界已经有Excel-Dna可以使用了，楼主不妨了解下，我现在的插件的自定义函数功能部分也是用Excel-Dna开发的，体验很不错，我放到我插件里，可以用插件来对它自动更新，如果单纯Excel-Dna的方式开发的话，用户电脑只需.net 4.0环境，无需管理员权限就能安装使用，发布的格式是xll格式，无需访问注册表。我插件的详细介绍，可以一起交流https://www.jianshu.com/u/1d0e4a6e400e

774115495

minren118 发表于 2018-2-7 20:31
这种方式开发出来的，估计需要用户有管理员权限来注册才能使用，轮子世界已经有Excel-Dna可以使用了，楼主 ...

Excel DNA 最大的优势在与开发函数，如果要操作Excel 对象估计就没有那么方便了，这种接口方式开发可以利用partial关键字来应用到vsto里面，从而实现了函数、Ribbon 一体化，而不需要单独用Excel DNA来开发，在涉及部署方面，Excel DNA 还要判断安装的OFFICE 是否是64位的。

hodrag

受教了，我还没开发过excel的类库

wyqzm

不错，这个方法也可以自定义UDF函数，并且没有多余的其它函数出现，ExcelDNA方式也有它的好处，重点在于函数定义，还有函数提示。

774115495

wyqzm 发表于 2018-3-10 17:53
不错，这个方法也可以自定义UDF函数，并且没有多余的其它函数出现，ExcelDNA方式也有它的好处，重点在于函 ...

还支持2003-2019  含32位和64位

wyqzm

774115495 发表于 2018-3-10 23:01
还支持2003-2019  含32位和64位

1. 有C#版本的吗？
2. 能支持函数提示就更好了。

jaybin023

很想学习vb.net创建自定义函数！不知从何入手啊！

UUOffice

楼主可以尝试用更高级的xll函数

lnissi

楼主好人，能不能把完整的工程文件发我学习学习（QQ邮箱:171130508@qq.com）