对word中来自Excel的图表进行格式设置code.docVIP

对word中来自Excel的图表进行格式设置code Public runcount As Integer Sub setfigure() 下面的命令将刚刚从Excel中复制过来的图形设定为悬浮锁定格式，并且将图形的来源位置设定为批注内容 ScreenUpdating = False Dim MyPicture As Shape, MyInPicture As InlineShape Dim fpath, shtname, chtadd, chtname, chttitle, s, s2 As String Dim xlApp As Excel.Application Dim xlbok As Excel.Workbook Dim intReturn As Integer 如果没有选中图形或者选中的图形不是inlineshape类型则结束程序 If Selection.Type = wdSelectionInlineShape Then Set MyPicture = Selection.InlineShapes(1).ConvertToShape runcount = 0 ElseIf Selection.Type = wdSelectionShape Then Set MyPicture = Selection.ShapeRange(1) Else MsgBox 你可能没有选中任何图形，请选中图形后重试！, vbExclamation, No Chart is Selected Exit Sub End If 对图片的格式进行设定，可以设置缩放比例 H1 = MyPicture.Height W1 = MyPicture.Width With MyPicture .LockAspectRatio = msoTrue .Height = 222.8 如果设定固定值选用这一语句，并将下面比例缩放语句前面加上英文单引号 .Width = 371.35 .Height = H1 * 0.85 设置为原图高度为0.85倍，可以设置其他按比例 .Width = W1 * 0.85 设置为原图宽度为0.85倍，可以设计其他比例 .WrapFormat.Type = wdWrapTopBottom 上下型 .WrapFormat.AllowOverlap = False 不允许重叠 .WrapFormat.Side = wdWrapBoth .RelativeHorizontalPosition = _ wdRelativeHorizontalPositionColumn .RelativeVerticalPosition = _ wdRelativeVerticalPositionParagraph .Left = wdShapeCenter .Top = CentimetersToPoints(0.2) .LockAnchor = True .LayoutInCell = False End With runcount = runcount + 11 将刚刚从Excel中拷贝出来的图表所在的位置设定为Word批注内容 同时还将为图片设定了超链接，链接地址为刚刚复制图片所在Excel文件 但是如果Excel没有打开，那么次图可能不是来源于Excel推出程序 On Error Resume Next Set xlApp = GetObject(, excel.application) If Err.Number = 429 Then MsgBox Excel程序没有打开,此图可能不来自Excel,因此未添加此图来源作为批注！, vbExclamation, No Excel is Open Else 如果Excel打开但是没有在Excel中选中任何图形，那么可能因为中间的操作导致图形没有选中。 Set xlbok = xlApp.ActiveWorkbook Set xl