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

Question

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

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

获取类似于.Bullet.Left或.Bullet.Top的输出的任何建议，类似于可以用一个形状完成的工作？

Answer 1

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

' ================================================================================ 
' 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 

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