以WORD方式打开该文件,粘贴以下代码:
Private Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long Private Declare Function CloseClipboard Lib "User32" () As Long Private Declare Function GetClipboardData Lib "User32" (ByVal uFormat As Long) As Long Private Declare Function CopyEnhMetaFileA Lib "Gdi32" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long Private Declare Function DeleteEnhMetaFile Lib "Gdi32" (ByVal hdc As Long) As Long Public Sub SavePic() Dim myPath As String, myTable As Table, strName As String Dim i As Cell, myRange As Range myPath = "D:\" '修改你的代码 Application.ScreenUpdating = False With ActiveDocument Set myTable = .Tables(1) For Each i In myTable.Range.Cells Set myRange = .Range(i.Range.Start, i.Range.End - 1) If i.Range.InlineShapes.Count = 1 Then Set myRange = .Range(i.Previous.Range.Start, i.Previous.Range.End - 1) If myRange = "" Then strName = Timer Else strName = myRange End If i.Range.InlineShapes(1).Range.Copy OpenClipboard 0 DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), myPath & strName & ".JPG") CloseClipboard End If Next End With Application.ScreenUpdating = True End Sub '----------------------
相关链接:http://club.excelhome.net/dispbbs.asp?boardid=23&replyid=425569&id=80674&page=1&skin=0&Star=5
[此贴子已经被作者于2005-12-7 11:06:41编辑过] |