Printable View
i have a form in which i have placed a imagelist.using some api calls i am able to store the icons from any dll into the imagelist. now the problem is when i want to transfer these icons programatically to a word file.
i have tried to solve this using a reference to
word application.i am able to copy the icons to the clipboard. but i am not able to copy it into the word file. please suggest me how to solve this problem.
Here is the code how to paste piuctures to Word from the clipboard
' Purpose
'Open Word and go to a bookmark
'
' Method
'Create a Word.Application server object. Use its Selection.GoTo method to
'the bookmark. Then use Selection.TypeText to enter text.
'
'Note that this project contains a reference to the Microsoft Word 8.0 Object
'Library. You may need to use a different library if you have a different
'version of Word.
Private WordServer As Word.Application
Private Sub Command1_Click()
Dim file_name As String
Dim file_path As String
Dim file_title As String
Dim txt As String
Dim new_txt As String
Dim pos As Integer
Screen.MousePointer = vbHourglass
Command1.Enabled = False
DoEvents
' Open Word.
file_name = txtFilename.Text
file_title = Mid$(file_name, InStrRev(file_name, "\") + 1)
file_path = Left$(file_name, Len(file_name) - Len(file_title))
' Uncomment to show Word.
' WordServer.Visible = True
WordServer.ChangeFileOpenDirectory file_path
WordServer.Documents.Open _
FileName:=file_title, _
ConfirmConversions:=False, _
ReadOnly:=False, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Format:=wdOpenFormatAuto
' Go to the bookmark.
WordServer.Selection.GoTo _
What:=wdGoToBookmark, _
Name:="Disclaimer"
WordServer.Selection.Find.ClearFormatting
With WordServer.Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Copy the image to the clipboard.
Clipboard.Clear
Clipboard.SetData Picture1.Picture, vbCFBitmap
' Paste the image into Word.
WordServer.Selection.Paste
' Comment out to keep Word running.
WordServer.Quit True
Set WordServer = Nothing
Screen.MousePointer = vbDefault
Command1.Enabled = True
End Sub
Private Sub Form_Load()
Dim file_name As String
file_name = App.Path
If Left$(file_name, 1) <> "\" Then file_name = file_name & "\"
file_name = file_name & "Readme.doc"
txtFilename.Text = file_name
On Error GoTo OpenError
Set WordServer = New Word.Application
On Error GoTo 0
Exit Sub
OpenError:
MsgBox "Error" & Str$(Error.Number) & _
" opening Word." & vbCrLf & _
Error.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
' Quit, saving changes.
If Not (WordServer Is Nothing) Then
WordServer.Quit True
Set WordServer = Nothing
End If
End Sub
Iouri Boutchkine
[email protected]
thank you for the solution.
but the problem in my case was that the icons in my image list were extracted from a dll and word did not recognise the format of the clipboard content.
any way i found a solution . it is as follows.
Private Sub mncreatenew_Click()
Dim wordApp As Word.Application
Dim img As InlineShape
Dim i As Integer
Dim myobj As Image
Dim dtype As WdPasteDataType
Dim mydialog As Dialog
Dim a As String
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
wordApp.Documents.Add
Set img = Selection.InlineShapes.AddOLEObject _(ClassType:="Paint.Picture", FileName:="", _
LinkToFile:=False, DisplayAsIcon:=False)
img.OLEFormat.Edit
For i = 1 To imgLarge.ListImages.Count
'transfering each icon from image listto picture box
picLarge.Picture = imgLarge.ListImages(i).Picture
Clipboard.Clear
'used an api call to copy the content of the picture box to clip board
Module1.CopyEntirePictureToClipboard picLarge
Set mydialog = Dialogs _(wdDialogEditPasteSpecial)
a$ = mydialog.Datatype
Application.ScreenUpdating = False
Selection.PasteSpecial Datatype:=wdPasteBitmap, Placement:=wdInLine
Next
wordApp.ActiveDocument.Close
wordApp.Application.Quit
End Sub
below is the api and the function for copying the content of picture bor to clipboard
Option Explicit
' General functions:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' GDI functions:
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
' Creates a memory DC
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
' Creates a bitmap in memory:
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
' Places a GDI Object into DC, returning the previous one:
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
' Deletes a GDI Object:
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
' Clipboard functions:
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
' Memory functions:
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Enum EPredefinedClipboardFormatConstants
[_First] = 1
CF_TEXT = 1
CF_BITMAP = 2
CF_METAFILEPICT = 3
CF_SYLK = 4
CF_DIF = 5
CF_TIFF = 6
CF_OEMTEXT = 7
CF_DIB = 8
CF_PALETTE = 9
CF_PENDATA = 10
CF_RIFF = 11
CF_WAVE = 12
CF_UNICODETEXT = 13
CF_ENHMETAFILE = 14
CF_HDROP = 15
CF_LOCALE = 16
CF_MAX = 17
[_Last] = 17
End Enum
Public Function CopyEntirePictureToClipboard(ByRef objFrom As Object) As Boolean
Dim lhDC As Long
Dim lhBmp As Long
Dim lhBmpOld As Long
' Create a DC compatible with the object we're copying
' from:
lhDC = CreateCompatibleDC(objFrom.hdc)
If (lhDC <> 0) Then
' Create a bitmap compatible with the object we're
' copying from:
lhBmp = CreateCompatibleBitmap(objFrom.hdc, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY)
If (lhBmp <> 0) Then
' Select the bitmap into the DC we have created,
' and store the old bitmap that was there:
lhBmpOld = SelectObject(lhDC, lhBmp)
' Copy the contents of objFrom to the bitmap:
BitBlt lhDC, 0, 0, objFrom.ScaleWidth \ Screen.TwipsPerPixelX, objFrom.ScaleHeight \ Screen.TwipsPerPixelY, objFrom.hdc, 0, 0, SRCCOPY
' Remove the bitmap from the DC:
SelectObject lhDC, lhBmpOld
' Now set the clipboard to the bitmap:
EmptyClipboard
OpenClipboard 0
SetClipboardData CF_BITMAP, lhBmp
CloseClipboard
' We don't delete the Bitmap here - it is now owned
' by the clipboard and Windows will delete it for us
' when the clipboard changes or the program exits.
End If
' Clear up the device context we created:
DeleteObject lhDC
CopyEntirePictureToClipboard = True
Else
CopyEntirePictureToClipboard = False
End If
End Function