Question

我试图创建一个可以在子弹上定位形状的vba（因为股票子弹太无聊了）。我无法确定每颗子弹的位置，因此我可以将形状放在它上面。

垂直位置会更有价值，因为那些更难排队。子弹不断移动（展开以填充形状），但每次移动时手动重新运行宏都没有问题。

有关获取类似于.Bullet.Left或.Bullet.Top的输出的任何建议，类似于可以对形状执行的操作？

Answer 1

您可以使用.Export将自定义项目符号形状作为PNG图片导出到文件系统，而不是覆盖对象然后必须处理文本框架的自动格式化，然后使用.Type重新导入它作为项目符号。。图片如下：

' ================================================================================
' PowerPoint VBA Macro
' Auther : Jamie GArroch of YOUpresent Ltd. http://youpresent.co.uk/
' Purpose : exports any on-slide object e.g.shape, group etc. and then
'           imports it for use as a bullet
' References : None
' Requirements : User must select two obects on the slide, one of which must
'                contain the text to be bulleted
' Inputs : None
' Outputs : None
' ================================================================================
Sub ExportShapeAndLoadAsBullet()
  Dim oShpText As Shape
  Const TmpPath = "C:\Temp\" ' make sure this path exists or changeto one that does
  Const BulletName = "myBullet.png"

  On Error GoTo errorhandler
  With ActiveWindow.Selection
    ' Check the user's selection
    If .Type <> ppSelectionShapes Then
      MsgBox "Please select the shape to use as a bullet and the text box to apply it to.", vbCritical + vbOKOnly, "Incorrect Selection"
      Exit Sub
    End If
    If .ShapeRange.Count <> 2 Then
      MsgBox "Please select the shape to use as a bullet and the text box to apply it to.", vbCritical + vbOKOnly, "Incorrect Selection"
      Exit Sub
    End If

    ' Export the object to use as a bullet and set a reference to the object to apply the bullet to
    If .ShapeRange(1).HasTextFrame Then
      If .ShapeRange(1).TextFrame.HasText Then
        Set oShpText = .ShapeRange(1)
        .ShapeRange(2).Export TmpPath & BulletName, ppShapeFormatPNG
      End If
    End If

    If .ShapeRange(2).HasTextFrame Then
      If .ShapeRange(2).TextFrame.HasText Then
        Set oShpText = .ShapeRange(2)
        .ShapeRange(1).Export TmpPath & BulletName, ppShapeFormatPNG
      End If
    End If
  End With

  If oShpText Is Nothing Then
    MsgBox "Couldn't find any text in either shape.", vbCritical + vbOKOnly, "No Text Found"
    Exit Sub
  End If

  ' Apply the exported bullet to the text
  With oShpText.TextFrame.TextRange.ParagraphFormat.Bullet
    .Type = ppBulletPicture
    .Picture TmpPath & BulletName
    .RelativeSize = 1
    Kill TmpPath & BulletName
  End With

  ' Clean up
  Set oShpText = Nothing
Exit Sub
errorhandler:
  MsgBox Err & " : ", Err.Description
End Sub

这样可以节省代码定位，还可以设置子弹图片的相对比例。

在选定项目符号的幻灯片上查找位置

1 个答案: