ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 10933|回复: 28

[原创] 另辟蹊径--VS2017自定义Excel函数(须安装NET4.0以上版本)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-2-3 13:17 | 显示全部楼层 |阅读模式
开发环境 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


1.jpg
2.jpg
3.jpg

VS2017自定义函数.rar

1.25 MB, 下载次数: 293

评分

1

查看全部评分

TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-2-8 08:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
minren118 发表于 2018-2-7 20:31
这种方式开发出来的,估计需要用户有管理员权限来注册才能使用,轮子世界已经有Excel-Dna可以使用了,楼主 ...

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

TA的精华主题

TA的得分主题

发表于 2018-2-23 18:42 | 显示全部楼层
受教了,我还没开发过excel的类库

TA的精华主题

TA的得分主题

发表于 2018-3-10 17:53 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
不错,这个方法也可以自定义UDF函数,并且没有多余的其它函数出现,ExcelDNA方式也有它的好处,重点在于函数定义,还有函数提示。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-3-10 23:01 来自手机 | 显示全部楼层
wyqzm 发表于 2018-3-10 17:53
不错,这个方法也可以自定义UDF函数,并且没有多余的其它函数出现,ExcelDNA方式也有它的好处,重点在于函 ...

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

TA的精华主题

TA的得分主题

发表于 2018-3-12 15:53 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
774115495 发表于 2018-3-10 23:01
还支持2003-2019  含32位和64位

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

TA的精华主题

TA的得分主题

发表于 2018-3-31 11:52 | 显示全部楼层
很想学习vb.net创建自定义函数!不知从何入手啊!

TA的精华主题

TA的得分主题

发表于 2018-4-26 13:51 | 显示全部楼层
楼主可以尝试用更高级的xll函数

TA的精华主题

TA的得分主题

发表于 2018-5-22 00:05 | 显示全部楼层
楼主好人,能不能把完整的工程文件发我学习学习(QQ邮箱:171130508@qq.com)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 10:12 , Processed in 0.044139 second(s), 15 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表