标题:求指点dll在excel的加载问题
只看楼主
linjie117
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2013-5-6
 问题点数:0 回复次数:0 
求指点dll在excel的加载问题
用.net编写了一个excel自定义函数,在excel中可以加载,但是加载后无法显示编写的自定义函数,有知道为什么的吗?
以下附带源码:
Imports System
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
<ComVisible(True)>
<ComClass(func.ClassId, func.InterfaceId, func.EventsId)> _
Public Class func

#Region "COM GUID"
    ' 这些 GUID 提供此类的 COM 标识
    ' 及其 COM 接口。若更改它们,则现有的
    ' 客户端将不再能访问此类。
    Public Const ClassId As String = "23e87623-7bcc-4521-9b19-2c1d55877647"
    Public Const InterfaceId As String = "edf21310-c4d5-4b21-a6fb-ecdd4b1bc529"
    Public Const EventsId As String = "97526ac0-dd73-4744-a580-a423ad4c1199"
#End Region

    ' 可创建的 COM 类必须具有一个不带参数的 Public Sub New()
    ' 否则, 将不会在
    ' COM 注册表中注册此类,且无法通过
    ' CreateObject 创建此类。
    Public Sub New()
        MyBase.New()
    End Sub
    ' 获取选中里程或桩号的设计高程,CeLiang_KM代表选中里程或者桩号, CeLiang_SQXSJK代表竖曲线数据库。
    Public Function CeLiang_GC(ByVal CeLiang_KM, ByVal CeLiang_SQXSJK)
        Dim KM
        Dim numbersRow As Integer, i As Integer
        Dim GCshujuku
        Dim Y1, Y2, Y3, Y4, Y5, Y6, Y7
        Y1 = ""
        Y2 = ""
        Y3 = ""
        Y4 = ""
        Y5 = ""
        Y6 = ""
        Y7 = ""
        Dim gc1, gc2, gc3
        KM = CeLiang_KM.value
        numbersRow = CeLiang_SQXSJK.Rows.Count
        GCshujuku = CeLiang_SQXSJK.Value
        For i = 1 To numbersRow
            If KM >= GCshujuku(i, 1) And KM <= GCshujuku(i, 2) Then
                Y1 = GCshujuku(i, 1)
                Y2 = GCshujuku(i, 2)
                Y3 = GCshujuku(i, 3)
                Y4 = GCshujuku(i, 4)
                Y5 = GCshujuku(i, 5)
                Y6 = GCshujuku(i, 6)
                Y7 = GCshujuku(i, 7)
                Exit For
            End If
        Next
        gc1 = Y5 - Y6
        gc2 = Math.Abs(gc1 * Y7) / 2
        Y7 = Y7 * Math.Abs(gc1) / gc1
        If KM <= Y4 - gc2 Then
            gc3 = 0
        Else
            If KM >= Y4 + gc2 Then
                gc3 = 0
                Y5 = Y6
            Else
                gc3 = KM - Y4 + gc2
            End If
        End If
        CeLiang_GC = Y3 - Y5 * (Y4 - KM) - gc3 * gc3 / 2 / Y7
        CeLiang_GC = Math.Round(CeLiang_GC, 3)
        Return CeLiang_GC
    End Function

    ' 获取选中里程或桩号的坐标值及方位角,CeLiang_KM代表选中里程或者桩号,CeLiang_BianJu代表距中距离,CeLiang_PQXSJK代表竖曲线数据库。
    Public Function CeLiang_ZBX(ByVal CeLiang_KM, ByVal CeLiang_BianJu, ByVal CeLiang_PQXSJK)
        Dim SelectionKM
        Dim SelectionBianJu
        Dim SelectionZBshujuku
        Dim i As Integer
        SelectionKM = CeLiang_KM.value
        SelectionBianJu = CeLiang_BianJu.value
        SelectionZBshujuku = CeLiang_PQXSJK.value
        numbersRow = CeLiang_PQXSJK.Rows.Count
        For i = 1 To numbersRow
            If SelectionKM >= SelectionZBshujuku(i, 1) And SelectionKM <= SelectionZBshujuku(i, 2) Then
                Y1 = SelectionZBshujuku(i, 1)
                Y2 = SelectionZBshujuku(i, 2)
                Y3 = SelectionZBshujuku(i, 3)
                Y4 = SelectionZBshujuku(i, 4)
                Y5 = SelectionZBshujuku(i, 5)
                Y6 = SelectionZBshujuku(i, 6)
                Y7 = SelectionZBshujuku(i, 7)
                Exit For
            End If
        Next
        B = SelectionKM - Y1
        Y8 = 0.5 * (1 / Y7 - 1 / Y6) / (Y2 - Y1)
        Y9 = Math.PI * Y5 / 180 + B / Y6 + Y8 * B * B
        CeLiang_ZBX = Y3 + QGAUS(A, B) + SelectionBianJu * Math.Cos(Y9 + Math.PI / 2)
        CeLiang_ZBX = Math.Round(CeLiang_ZBX, 3)
        Return CeLiang_ZBX
    End Function
    Public Function CeLiang_ZBY(ByVal CeLiang_KM, ByVal CeLiang_BianJu, ByVal CeLiang_PQXSJK)
        Dim SelectionKM
        Dim SelectionBianJu
        Dim SelectionZBshujuku
        Dim i As Integer
        SelectionKM = CeLiang_KM.value
        SelectionBianJu = CeLiang_BianJu.value
        SelectionZBshujuku = CeLiang_PQXSJK.value
        numbersRow = CeLiang_PQXSJK.Rows.Count
        For i = 1 To numbersRow
            If SelectionKM >= SelectionZBshujuku(i, 1) And SelectionKM <= SelectionZBshujuku(i, 2) Then
                Y1 = SelectionZBshujuku(i, 1)
                Y2 = SelectionZBshujuku(i, 2)
                Y3 = SelectionZBshujuku(i, 3)
                Y4 = SelectionZBshujuku(i, 4)
                Y5 = SelectionZBshujuku(i, 5)
                Y6 = SelectionZBshujuku(i, 6)
                Y7 = SelectionZBshujuku(i, 7)
                Exit For
            End If
        Next
        B = SelectionKM - Y1
        Y8 = 0.5 * (1 / Y7 - 1 / Y6) / (Y2 - Y1)
        Y9 = Math.PI * Y5 / 180 + B / Y6 + Y8 * B * B
        CeLiang_ZBY = Y4 + QGAUSY(A, B) + SelectionBianJu * Math.Sin(Y9 + Math.PI / 2)
        CeLiang_ZBY = Math.Round(CeLiang_ZBY, 3)
        Return CeLiang_ZBY
    End Function
    Public Function CeLiang_FWJ(ByVal CeLiang_KM, ByVal CeLiang_BianJu, ByVal CeLiang_PQXSJK)
        Dim SelectionKM
        Dim SelectionBianJu
        Dim SelectionZBshujuku
        Dim i As Integer
        SelectionKM = CeLiang_KM.value
        SelectionBianJu = CeLiang_BianJu.value
        SelectionZBshujuku = CeLiang_PQXSJK.value
        numbersRow = CeLiang_PQXSJK.Rows.Count
        For i = 1 To numbersRow
            If SelectionKM >= SelectionZBshujuku(i, 1) And SelectionKM <= SelectionZBshujuku(i, 2) Then
                Y1 = SelectionZBshujuku(i, 1)
                Y2 = SelectionZBshujuku(i, 2)
                Y3 = SelectionZBshujuku(i, 3)
                Y4 = SelectionZBshujuku(i, 4)
                Y5 = SelectionZBshujuku(i, 5)
                Y6 = SelectionZBshujuku(i, 6)
                Y7 = SelectionZBshujuku(i, 7)
                Exit For
            End If
        Next
        B = SelectionKM - Y1
        Y8 = 0.5 * (1 / Y7 - 1 / Y6) / (Y2 - Y1)
        CeLiang_FWJ = Math.PI * Y5 / 180 + B / Y6 + Y8 * B * B
        CeLiang_FWJ = CeLiang_FWJ * 180 / Math.PI
        CeLiang_FWJ = Math.Round(CeLiang_FWJ, 8)
        Return CeLiang_FWJ
    End Function
    ' 已知坐标反算里程桩号及距中距离,CeLiang_KM代表选中里程或者桩号,CeLiang_BianJu代表距中距离,CeLiang_PQXSJK代表竖曲线数据库。
    Public Function CeLiang_KM(ByVal CeLiang_ZBX, ByVal CeLiang_ZBY, ByVal CeLiang_PQXSJK)
        Dim PolI, PolJ, KMadd, ZBX, ZBY
        Dim i As Integer
        SelectionKM = 0
        SelectionBianJu = 0
        SelectionFSX = CeLiang_ZBX.value
        SelectionFSY = CeLiang_ZBY.value
        SelectionZBshujuku = CeLiang_PQXSJK.value
        numbersRow = CeLiang_PQXSJK.Rows.Count
        Do
            For i = 1 To numbersRow
                If SelectionKM >= SelectionZBshujuku(i, 1) And SelectionKM <= SelectionZBshujuku(i, 2) Then
                    Y1 = SelectionZBshujuku(i, 1)
                    Y2 = SelectionZBshujuku(i, 2)
                    Y3 = SelectionZBshujuku(i, 3)
                    Y4 = SelectionZBshujuku(i, 4)
                    Y5 = SelectionZBshujuku(i, 5)
                    Y6 = SelectionZBshujuku(i, 6)
                    Y7 = SelectionZBshujuku(i, 7)
                    Exit For
                End If
            Next
            B = SelectionKM - Y1
            Y8 = 0.5 * (1 / Y7 - 1 / Y6) / (Y2 - Y1)
            Y9 = Math.PI * Y5 / 180 + B / Y6 + Y8 * B * B
            ZBX = Y3 + QGAUS(A, B) + SelectionBianJu * Math.Cos(Y9 + Math.PI / 2)
            ZBY = Y4 + QGAUSY(A, B) + SelectionBianJu * Math.Sin(Y9 + Math.PI / 2)
            PolI = Math.Sqrt(Math.Pow(ZBX - SelectionFSX, 2) + Math.Pow(ZBY - SelectionFSY, 2))
            PolJ = Math.Atan((ZBY - SelectionFSY) / (ZBX - SelectionFSX + 0.000001))
            KMadd = PolI * Math.Sin(Y9 - Math.PI / 2 - PolJ)
            SelectionKM = SelectionKM + KMadd
        Loop While KMadd > 0.001
        CeLiang_KM = Math.Round(SelectionKM, 3)
        Return CeLiang_KM
    End Function
    Public Function CeLiang_BianJu(ByVal CeLiang_ZBX, ByVal CeLiang_ZBY, ByVal CeLiang_PQXSJK)
        Dim PolI, PolJ, KMadd, ZBX, ZBY
        SelectionKM = 0
        SelectionBianJu = 0
        SelectionFSX = CeLiang_ZBX.value
        SelectionFSY = CeLiang_ZBY.value
        SelectionZBshujuku = CeLiang_PQXSJK.value
        numbersRow = CeLiang_PQXSJK.Rows.Count
        Do
            For i = 1 To numbersRow
                If SelectionKM >= SelectionZBshujuku(i, 1) And SelectionKM <= SelectionZBshujuku(i, 2) Then
                    Y1 = SelectionZBshujuku(i, 1)
                    Y2 = SelectionZBshujuku(i, 2)
                    Y3 = SelectionZBshujuku(i, 3)
                    Y4 = SelectionZBshujuku(i, 4)
                    Y5 = SelectionZBshujuku(i, 5)
                    Y6 = SelectionZBshujuku(i, 6)
                    Y7 = SelectionZBshujuku(i, 7)
                    Exit For
                End If
            Next
            B = SelectionKM - Y1
            Y8 = 0.5 * (1 / Y7 - 1 / Y6) / (Y2 - Y1)
            Y9 = Math.PI * Y5 / 180 + B / Y6 + Y8 * B * B
            ZBX = Y3 + QGAUS(A, B) + SelectionBianJu * Math.Cos(Y9 + Math.PI / 2)
            ZBY = Y4 + QGAUSY(A, B) + SelectionBianJu * Math.Sin(Y9 + Math.PI / 2)
            PolI = Math.Sqrt(Math.Pow(ZBX - SelectionFSX, 2) + Math.Pow(ZBY - SelectionFSY, 2))
            PolJ = Math.Atan((ZBY - SelectionFSY) / (ZBX - SelectionFSX + 0.000001))
            KMadd = PolI * Math.Sin(Y9 - Math.PI / 2 - PolJ)
            SelectionKM = SelectionKM + KMadd
        Loop While KMadd > 0.001
        CeLiang_BianJu = Math.Round(PolI, 3)
        Return CeLiang_BianJu
    End Function

    <ComRegisterFunctionAttribute()> Public Shared Sub RegisterFunction(ByVal type As Type)
        Registry.ClassesRoot.CreateSubKey(GetSubKeyName(type, "Programmable"))
        Dim key = Registry.ClassesRoot.OpenSubKey(GetSubKeyName(type, "InprocServer32"), True)
        key.SetValue("", System.Environment.SystemDirectory + "\mscoree.dll",RegistryValueKind.String)
    End Sub
    <ComUnregisterFunctionAttribute()> Public Shared Sub UnregisterFunction(ByVal type As Type)
        Registry.ClassesRoot.DeleteSubKey(GetSubKeyName(type, "Programmable"), False)
    End Sub
    Private Shared Function GetSubKeyName(ByVal type As Type, ByVal subKeyName As String) As String
        return string.Format("CLSID\\{{{0}}}\\{1}", type.GUID.ToString().ToUpper(), subKeyName)
    End Function
End Class
搜索更多相关主题的帖子: excel 客户端 接口 
2015-04-15 22:49



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-444062-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.109334 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved