Sub Del_Text_Selected_Shapes() Dim oSR As ShapeRange Dim oShp As Shape MsgBox "To add modular approach", vbCritical: Exit Sub On Error Resume Next With ActiveWindow.Selection If .HasChildShapeRange Then Set oSR = ActiveWindow.Selection.ChildShapeRange Else Set oSR = ActiveWindow.Selection.ShapeRange End If End With If oSR Is Nothing Then MsgBox "Unable to proceed as shapes haven't been selected.": Exit Sub For Each oShp In oSR Select Case oShp.Type Case msoGroup Dim oGrpItem As Shape For Each oGrpItem In oShp.GroupItems If oGrpItem.HasTextFrame Then oGrpItem.TextFrame.DeleteText Next Case msoTable Dim lCol As Long, lRow As Long With oShp.Table For lCol = 1 To .Rows.Count For lRow = 1 To .Columns.Count With .Cell(lRow, lCol).Shape.TextFrame If .HasText Then .DeleteText End With Next Next End With Case Else If oShp.HasTextFrame Then oShp.TextFrame.DeleteText End Select Next End Sub
Public Sub Swap_Shapes() Dim oApp As Object ' Excel, PowerPoint or Word application Dim sngTop As Single Dim sngLeft As Single Dim oSR As ShapeRange On Error Resume Next Set oApp = Application With ActiveWindow.Selection Select Case oApp.Name Case "Microsoft PowerPoint" If .HasChildShapeRange Then Set oSR = .ChildShapeRange Else Set oSR = .ShapeRange End If Case "Microsoft Excel" Set oSR = .ShapeRange Case "Microsoft Word" If .ShapeRange(1).Type = msoCanvas Then Set oSR = .ChildShapeRange Else Set oSR = .ShapeRange End If End Select End With If oSR Is Nothing Then MsgBox "Unable to proceed as shapes haven't been selected.": Exit Sub If oSR.Count <> 2 Then MsgBox "You must select two shapes.": Exit Sub With oSR sngTop = .Item(1).Top sngLeft = .Item(1).Left .Item(1).Top = .Item(2).Top .Item(1).Left = .Item(2).Left .Item(2).Top = sngTop .Item(2).Left = sngLeft End With End Sub
Gain unlimited access to on-demand training courses with an Experts Exchange subscription.Get Access
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.