|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 loquat 于 2023-8-27 21:51 编辑
直接cropRight好像上下也需要处理。
- #If VBA7 And Win64 Then
- Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
- #Else
- Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
- #End If
- Sub 区域转图片(rng As Range)
- Dim iStart As Long
- Dim iEnd As Long
- Dim iWidth As Double
- iStart = rng.Start
- iEnd = rng.End '记录待处理
- rng.SetRange iStart, iStart
- iWidth = rng.Information(wdHorizontalPositionRelativeToTextBoundary)
- rng.SetRange iEnd, iEnd
- iWidth = rng.Information(wdHorizontalPositionRelativeToTextBoundary) - iWidth
- rng.SetRange iStart, iEnd
- rng.CopyAsPicture
- 'Sleep 1000
- rng.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
- rng.SetRange iStart, iStart + 1
- With rng.InlineShapes(1)
- .PictureFormat.CropRight = (.Width - iWidth) / .ScaleWidth * 100
- End With
- End Sub
复制代码
|
评分
-
2
查看全部评分
-
|