dotNETportal.cz

Kvuli jedné aplikaci ve VBA potřebuji udělat malou COM knihovnu a zkouším ji vytvořit přes vb.net. Použiju template pro COM knihovnu a vše se zkompiluje a zaregistruje. Po zkompilovani, knihovnu vidim v referencich (VBA) a take v registrech jako řádně zaregistrovanou.

Ale když ji zkoušim použít (createobject ("WMFromClipboard.WMFromClipboard")) tak získám jen error, že assembly nemá k dispozici další nutné knihovny. Ale je to jen jednoduchá třída a kromě .NET jádra/WIN nepoužívám jiné knihovny. Zkoušel jsem DLL+TLB nakopírovat i do /system32, ale stále stejná chyba. Přes Object Browser ve VBA ji můžu procházet a její metody vidím.

Netušíte, kde dělám botu?

Moc dík.

Imports System.Drawing
Imports System.Windows.Forms
Imports System.Runtime.InteropServices

<ComClass(WMFromClipboard.ClassId, WMFromClipboard.InterfaceId, WMFromClipboard.EventsId)> _
Public Class WMFromClipboard

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "47501623-39f4-473e-b63d-cf3117f0c5be"
    Public Const InterfaceId As String = "3e9cc7fc-ba71-4176-8185-0d747c00237a"
    Public Const EventsId As String = "0a1d6650-a792-4c42-b83a-98108160ed4b"
#End Region

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Private myImage As Bitmap

    Public Sub New()
        MyBase.New()
    End Sub

    Public Function GetClipboardContent() As Boolean
        Dim myObject As DataObject
        Dim Formats() As String
        Dim myMeta As Imaging.Metafile

        myObject = Clipboard.GetDataObject
        Formats = myObject.GetFormats
        If Not Formats.Contains("MetaFilePict") Then Return False

        Try
            myMeta = Me.GetMetafile
        Catch ex As Exception
            Return False
        End Try

        myImage = New Bitmap(myMeta, myMeta.Width * 3, myMeta.Height * 3)
        myMeta.Dispose()
        Return True
    End Function

    Public Sub SaveFile(ByVal FileName As String)
        If Me.myImage Is Nothing Then Return
        myImage.Save(FileName, Imaging.ImageFormat.Png)
    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
        Me.myImage.Dispose()
    End Sub

    Private Function GetMetafile() As System.Drawing.Imaging.Metafile
        Const CF_ENHMETAFILE As Integer = 14

        Dim ip As IntPtr
        Dim metaFile As System.Drawing.Imaging.Metafile
        Dim bRet As Boolean

        bRet = WMFromClipboard.OpenClipboard(Nothing) 'zadny handle nemam a tak dam nic coz znamena ze to bude asociovane s current task

        If bRet = True Then
            'Verify the clipboard contains data available
            'as an enhanced metafile.
            bRet = WMFromClipboard.IsClipboardFormatAvailable(CF_ENHMETAFILE) <> 0
        End If

        If bRet = True Then
            'Store the clipboard's contents in the IntPtr.
            ip = WMFromClipboard.GetClipboardData(CF_ENHMETAFILE)
        End If

        'Verify the IntPrt contains data before proceeding. Passing
        'an empty IntPtr to System.Drawing.Imaging.Metafile results
        'in an exception.
        If Not IntPtr.Zero.Equals(ip) Then
            metaFile = New System.Drawing.Imaging.Metafile(ip, True)
            WMFromClipboard.CloseClipboard()
            Return metaFile
        Else
            Return Nothing
        End If
    End Function

    <DllImport("user32.dll", EntryPoint:="OpenClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Function OpenClipboard(ByVal hWnd As IntPtr) As Boolean
    End Function

    <DllImport("user32.dll", EntryPoint:="EmptyClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Function EmptyClipboard() As Boolean
    End Function

    <DllImport("user32.dll", EntryPoint:="SetClipboardData", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
     Private Shared Function SetClipboardData(ByVal uFormat As Integer, ByVal ByValhWnd As IntPtr) As IntPtr()
    End Function

    <DllImport("user32.dll", EntryPoint:="CloseClipboard", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Function CloseClipboard() As Boolean
    End Function

    <DllImport("user32.dll", EntryPoint:="GetClipboardData", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Function GetClipboardData(ByVal uFormat As Integer) As IntPtr
    End Function

    <DllImport("user32.dll", EntryPoint:="IsClipboardFormatAvailable", SetLastError:=True, ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
    Private Shared Function IsClipboardFormatAvailable(ByVal uFormat As Integer) As Short
    End Function
End Class

Pravda. Něco jsem s touhle problematikou pohledal a narazil na samé problémy, které mi za to nestály. Tak jsem změnil design a nyní ovládám COM komponenty z .NET - to je zcela bez problémové.

P.