找到選定項目符號的幻燈片上的位置

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 

這樣可以節省代碼定位的空間，也可以設置子彈圖片的相對比例。