如何用VBA将Word文档中的域代码公式复制为图片，求大家指点

过客fppt

感谢batmanbbs、zhanglei1371和loquat三位老师在过去的17天里的帮助。特别是batmanbbs老师在VBA中找到了内置的裁剪图片.CropRight属性，这是解决问题的关键。在没有这个代码之前，将这些资料上传到系统时效率非常低。再次向大家表示衷心的感谢！



效果展示：https://www.bilibili.com/video/BV1J84y1Z7nT/?vd_source=4a3df716573e6943c72af2a16193109a

loquat

过客fppt 发表于 2023-8-21 08:54
是的，我觉得裁剪比较好；放大字体的循环，如果能一次到位更好，但是不同eq公式中，字母数量不同，放大的 ...

直接计算宽度，尝试换算一步到位

过客fppt

loquat 发表于 2023-8-22 21:02
直接计算宽度，尝试换算一步到位

裁剪图片是一次到位的。放大字体一步到位的话，我想不到什么方法。

过客fppt

【今天终于实现了在WPS中大批量转换公式为图片-哔哩哔哩】 https://b23.tv/ngZzCCS

相见是缘8

过客fppt 发表于 2023-8-23 15:38
【今天终于实现了在WPS中大批量转换公式为图片-哔哩哔哩】 https://b23.tv/ngZzCCS

祝贺过客 fppt 老师完美达愿！

过客fppt

相见是缘8 发表于 2023-8-24 07:07
祝贺过客 fppt 老师完美达愿！

谢谢，都是在论坛里各位老师鼎力支持下的成果！

相见是缘8

过客fppt 发表于 2023-8-24 09:02
谢谢，都是在论坛里各位老师鼎力支持下的成果！

过客 fppt 老师好！
能把各位老师的成果整合在一起，证明你也有实力！

loquat

过客fppt 发表于 2023-8-22 21:39
裁剪图片是一次到位的。放大字体一步到位的话，我想不到什么方法。

有啊，直接设置一个略大的值，超出正文宽度即可

过客fppt

loquat 发表于 2023-8-24 21:50
有啊，直接设置一个略大的值，超出正文宽度即可

超过的话，选中区域会自动分行，生成图片也是两行的了

loquat

直接cropRight好像上下也需要处理。

1. #If VBA7 And Win64 Then
   
2. Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
   
3. #Else
   
4. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
   
5. #End If
   
6. 
   
7. Sub 区域转图片(rng As Range)
   
8.     Dim iStart As Long
   
9.     Dim iEnd As Long
   
10.     Dim iWidth As Double
    
11.     iStart = rng.Start
    
12.     iEnd = rng.End      '记录待处理
    
13.     rng.SetRange iStart, iStart
    
14.     iWidth = rng.Information(wdHorizontalPositionRelativeToTextBoundary)
    
15.     rng.SetRange iEnd, iEnd
    
16.     iWidth = rng.Information(wdHorizontalPositionRelativeToTextBoundary) - iWidth
    
17.     rng.SetRange iStart, iEnd
    
18.     rng.CopyAsPicture
    
19.     'Sleep 1000
    
20.     rng.PasteSpecial DataType:=wdPasteMetafilePicture, Placement:=wdInLine
    
21.     rng.SetRange iStart, iStart + 1
    
22.     With rng.InlineShapes(1)
    
23.         .PictureFormat.CropRight = (.Width - iWidth) / .ScaleWidth * 100
    
24.     End With
    
25. End Sub

复制代码