Coppy các nét vẻ vào trang tính InkPicture, sử dụng điều khiển InkPicture cung cấp khả năng đặt một hình ảnh trong một ứng dụng và cho phép người dùng vẽ mực lên trên nó. Nó dành cho các trường hợp trong đó mực không được nhận dạng là văn bản mà thay vào đó được lưu trữ dưới nét bút.

Coppy các nét vẻ vào trang tính InkPicture

Bạn có thể sử dụng điều khiển InkPicture để hiển thị mực trong Microsoft Windows 2000, Windows Server 2003, bất kỳ phiên bản nào của Windows XP ngoài Windows XP Tablet PC Edition và bất kỳ phiên bản nào của Windows Vista.

Tuy nhiên, bạn có thể nhập mực, chấp nhận cử chỉ hoặc chỉ nhận dạng chữ viết tay trong các điều kiện. Bạn có thể tham khảo đoạn code sau

Để sử dụng được Control Microsoft lnk Picture Control : Click chuột phải vào bản toolbox chọn Microsoft lnk Picture Control

Tạo điều khiển InkPicture đằng sau điều khiển trong suốt (chẳng hạn như GroupBox với bộ thuộc tính WS_EX_TRANSPARENT) sẽ ngăn InkPicture thu thập mực.

Mực có thể được nhập và nhận dạng nếu Windows Vista hoặc XP Tablet PC Edition 2005 được cài đặt. Cử chỉ cũng có thể được nhận ra. Chữ viết tay có thể được nhận dạng dưới dạng văn bản nếu chữ viết tay bắt nguồn từ các máy chạy phiên bản Windows cũ hơn, miễn là có trình nhận dạng.

Nếu bạn sử dụng Windows 2000, Windows Server 2003, bất kỳ phiên bản nào của Windows XP ngoài Windows XP Tablet PC Edition 2005, bạn có thể gán giá trị cho các thuộc tính môi trường xung quanh của điều khiển InkPicture.

Sau đó sao chép và dán mực vào các ứng dụng khác. Tuy nhiên, giá trị của thuộc tính InkEnabled sẽ luôn là FALSE .

I.CODE Coppy các nét vẻ vào trang tính InkPicture

Option Explicit
Private Type uPicDesc
    Size As Long
    Type As Long
    #If VBA7 Then
        hPic As LongPtr
        hPal As LongPtr
    #Else
       hPic As Long
       hPal As Long
    #End If
End Type
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
#If VBA7 Then
    Private Declare PtrSafe Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare PtrSafe Function CopyImage Lib "user32" (ByVal handle As LongPtr, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
    Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
    Private hCopy As LongPtr, hPtr As LongPtr, hLib As LongPtr
#Else
    Private Declare Function OleCreatePictureIndirectAut Lib "oleAut32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function OleCreatePictureIndirectPro Lib "olepro32.dll" Alias "OleCreatePictureIndirect" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
    Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
    Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
    Private hCopy As Long, hPtr As Long, hLib As Long
#End If
Private Const IMAGE_BITMAP = 0
Private Const PICTYPE_BITMAP = 1
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2
Private Const S_OK = 0
Private oInitPic As IPicture
Private oCurrentShape As Object
Private Sub UserForm_Initialize()
    InkPicture1.DefaultDrawingAttributes.Color = vbRed
    Set oInitPic = CreatePicture(Me.InkPicture1)
End Sub
'Private Sub UserForm_Terminate()
'    If Not oCurrentShape Is Nothing Then oCurrentShape.Delete
'End Sub
Private Sub Cmd_CopyToSheet_Click()
    If Me.InkPicture1.Ink.Strokes.Count Then
        Me.InkPicture1.Ink.ClipboardCopy
        Range("B2").PasteSpecial xlPasteAll
        Set oCurrentShape = Selection
        oCurrentShape.TopLeftCell.Select
        Me.InkPicture1.Ink.DeleteStrokes
    Else
        If Not oCurrentShape Is Nothing Then
            Set Me.InkPicture1.Picture = oInitPic
            oCurrentShape.Visible = True
        End If
    End If
    Me.InkPicture1.AutoRedraw = True
End Sub
Private Function CreatePicture(ByVal Shape As Object) As IPicture
    Dim IID_IDispatch As GUID, uPicinfo As uPicDesc
    Dim iPic As IPicture, lRet As Long
    On Error GoTo errHandler
    Shape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    OpenClipboard 0
    hPtr = GetClipboardData(CF_BITMAP)
    hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    With uPicinfo
        .Size = Len(uPicinfo)
        .Type = PICTYPE_BITMAP
        .hPic = hCopy
        .hPal = 0
    End With
    hLib = LoadLibrary("oleAut32.dll")
    If hLib Then
        lRet = OleCreatePictureIndirectAut(uPicinfo, IID_IDispatch, True, iPic)
    Else
        lRet = OleCreatePictureIndirectPro(uPicinfo, IID_IDispatch, True, iPic)
    End If
    FreeLibrary hLib
    If lRet = S_OK Then
        Set CreatePicture = iPic
    End If
errHandler:
    EmptyClipboard
    CloseClipboard
Kết thúc chức năng