从 excel 和 pasteSpecial 复制范围到单词时,我想在图片周围添加边框线
when copying a range from excel and pasteSpecial to word I want to add a border line around the picture
我有两个问题。
1 在 Word 中,我可以转到书签“输入”,但我想保留该书签并将我的选择粘贴到新书签中这一书签下方的一行。我试过 .selection.Collapse Direction:=wdCollapseEnd 到最后,然后 insertLine 但这并没有达到目的。在粘贴之前也尝试了 ActiveDocument.Bookmarks.Add "Excel1", newRange (请参阅代码的注释部分)但也没有运气。
2 当我使用 DataType:=wdPasteEnhancedMetafile 将范围从 excel 复制到 word 时,左边框在 word 中不可见(其他边框很好。粘贴元文件图片后如何添加左边框?
' in excel
selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
lWidth = selection.Width
lHeight = selection.Height
wdDoc.Activate
' With wdApp
'' Set prevRange = wrdDoc.Bookmarks("input").Range
' Set newRange = prevRange 'Have to set the range to something initially
' newRange.SetRange prevRange.End, prevRange.End
' ActiveDocument.Bookmarks.Add "Excel1", newRange
'End With
With wdApp
.Visible = True
.selection.Goto What:=wdGoToBookmark, Name:="input"
.selection.Collapse Direction:=wdCollapseEnd
'leave the bookmark input as input and make a new bookmark on next word line for the picture.
.selection.InsertLine
.selection.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInline
'add a line at the left border of metafile ??
'.Selection.InsertAfter Chr(13)
.selection.InsertBreak (wdPageBreak)
End With
nextXL:
对于第一期,请尝试以下方式:
Sub Demo()
Dim xlSht As Excel.Worksheet
Dim wdApp As Word.Application, wdDoc As Word.Document, wdRng As Word.Range
Dim StrDocNm As String, StrBkMk As String
Set xlSht = ActiveSheet
StrBkMk = "BkMk1"
Set wdApp = GetObject(, "Word.Application")
With wdApp
'Point to the active document
Set wdDoc = .ActiveDocument
With wdDoc
'Paste the Excel data at the designated bookmark
If .Bookmarks.Exists(StrBkMk) Then
xlSht.Range("C2:E7").Copy
Set wdRng = .Bookmarks(StrBkMk).Range
wdRng.Characters.Last.Next.InsertBefore vbCr
wdRng.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.Bookmarks.Add StrBkMk, wdRng
xlSht.Range("C9:E15").Copy
With wdRng
.End = .End + 1
.Collapse wdCollapseEnd
.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.Bookmarks.Add "BkMk2", .Duplicate
End With
End If
End With
End With
Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing
End Sub
请注意,在 Word 或 Excel 中不需要 Select 任何内容。另请注意,我没有包含任何用于打开文档等的代码。我假设您已经对它进行了排序。
对于第二个问题,边框似乎已应用到相邻单元格的右侧,而不是复制单元格的左侧。我建议在源头上进行更正。
我有两个问题。 1 在 Word 中,我可以转到书签“输入”,但我想保留该书签并将我的选择粘贴到新书签中这一书签下方的一行。我试过 .selection.Collapse Direction:=wdCollapseEnd 到最后,然后 insertLine 但这并没有达到目的。在粘贴之前也尝试了 ActiveDocument.Bookmarks.Add "Excel1", newRange (请参阅代码的注释部分)但也没有运气。 2 当我使用 DataType:=wdPasteEnhancedMetafile 将范围从 excel 复制到 word 时,左边框在 word 中不可见(其他边框很好。粘贴元文件图片后如何添加左边框?
' in excel
selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
lWidth = selection.Width
lHeight = selection.Height
wdDoc.Activate
' With wdApp
'' Set prevRange = wrdDoc.Bookmarks("input").Range
' Set newRange = prevRange 'Have to set the range to something initially
' newRange.SetRange prevRange.End, prevRange.End
' ActiveDocument.Bookmarks.Add "Excel1", newRange
'End With
With wdApp
.Visible = True
.selection.Goto What:=wdGoToBookmark, Name:="input"
.selection.Collapse Direction:=wdCollapseEnd
'leave the bookmark input as input and make a new bookmark on next word line for the picture.
.selection.InsertLine
.selection.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInline
'add a line at the left border of metafile ??
'.Selection.InsertAfter Chr(13)
.selection.InsertBreak (wdPageBreak)
End With
nextXL:
对于第一期,请尝试以下方式:
Sub Demo()
Dim xlSht As Excel.Worksheet
Dim wdApp As Word.Application, wdDoc As Word.Document, wdRng As Word.Range
Dim StrDocNm As String, StrBkMk As String
Set xlSht = ActiveSheet
StrBkMk = "BkMk1"
Set wdApp = GetObject(, "Word.Application")
With wdApp
'Point to the active document
Set wdDoc = .ActiveDocument
With wdDoc
'Paste the Excel data at the designated bookmark
If .Bookmarks.Exists(StrBkMk) Then
xlSht.Range("C2:E7").Copy
Set wdRng = .Bookmarks(StrBkMk).Range
wdRng.Characters.Last.Next.InsertBefore vbCr
wdRng.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.Bookmarks.Add StrBkMk, wdRng
xlSht.Range("C9:E15").Copy
With wdRng
.End = .End + 1
.Collapse wdCollapseEnd
.PasteSpecial Link:=False, DisplayAsIcon:=False, _
DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.Bookmarks.Add "BkMk2", .Duplicate
End With
End If
End With
End With
Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing
End Sub
请注意,在 Word 或 Excel 中不需要 Select 任何内容。另请注意,我没有包含任何用于打开文档等的代码。我假设您已经对它进行了排序。
对于第二个问题,边框似乎已应用到相邻单元格的右侧,而不是复制单元格的左侧。我建议在源头上进行更正。