Hello Every one,
I was looking for VBA code which will auto create all abbreviation in any PPT file, luckily I found one over google search,thanks for its makers
VBA Code is:
However, I would like to tweak this code a bit, I don't want any numbers in abbreviation list, currently it also including all the numbers.Sub use_regexABB() Dim regX As Object Dim oMatch As Object Dim osld As Slide Dim oshp As Shape Dim strInput As String Dim b_found As Boolean Dim strReport As String Dim iRow As Integer Dim iCol As Integer Dim i As Integer Dim GI As Long Dim iFileNum As Integer Dim b_First As Boolean Dim b_start As Boolean Dim strpattern As String strpattern = "[A-Z(.\d)?]{2,}" 'CAPS with optional . or digit On Error Resume Next Set regX = CreateObject("vbscript.regexp") With regX .Global = True .Pattern = strpattern End With For Each osld In ActivePresentation.Slides For Each oshp In osld.Shapes Select Case oshp.Type Case Is = 14 If oshp.HasTable Then For iRow = 1 To oshp.Table.Rows.Count For iCol = 1 To oshp.Table.Columns.Count strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text b_found = regX.Test(strInput) If b_found = True Then If Err <> 0 Then MsgBox strpattern & " is not a recognised RegEx pattern." Exit Sub End If If Not b_start Then b_start = True strReport = strReport & "Results" & vbCrLf End If If Not b_First And b_start Then strReport = strReport & vbCrLf & "In Table on Slide " & osld.SlideIndex & ": " b_First = True Else End If Set oMatch = regX.Execute(strInput) For i = 0 To oMatch.Count - 1 strReport = strReport & oMatch(i) & " / " Next i End If Next iCol Next iRow End If If oshp.HasTextFrame And Not oshp.HasTable Then If oshp.TextFrame.HasText Then strInput = oshp.TextFrame.TextRange.Text b_found = regX.Test(strInput) If Err <> 0 Then MsgBox strpattern & " is not a recognised RegEx pattern." Exit Sub End If If b_found = True Then If Not b_start Then b_start = True strReport = strReport & "Results" & vbCrLf End If If Not b_First And b_start Then strReport = strReport & vbCrLf & "In Placeholder on Slide " & osld.SlideIndex & ": " b_First = True Else End If Set oMatch = regX.Execute(strInput) For i = 0 To oMatch.Count - 1 strReport = strReport & oMatch(i) & " / " Next i End If End If End If Case Is = msoSmartArt For GI = 1 To oshp.GroupItems.Count If oshp.GroupItems(GI).HasTextFrame Then If oshp.GroupItems(GI).TextFrame2.HasText Then strInput = oshp.GroupItems(GI).TextFrame2.TextRange.Text b_found = regX.Test(strInput) If b_found = True Then If Err <> 0 Then MsgBox strpattern & " is not a recognised RegEx pattern." Exit Sub End If If Not b_start Then b_start = True strReport = strReport & "Results" & vbCrLf End If If Not b_First And b_start Then strReport = strReport & vbCrLf & "In Smart Art on Slide " & osld.SlideIndex & ": " b_First = True Else End If Set oMatch = regX.Execute(strInput) For i = 0 To oMatch.Count - 1 strReport = strReport & oMatch(i) & " / " Next i End If End If End If Next GI Case Else If oshp.HasTable Then For iRow = 1 To oshp.Table.Rows.Count For iCol = 1 To oshp.Table.Columns.Count strInput = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange.Text b_found = regX.Test(strInput) If b_found = True Then If Err <> 0 Then MsgBox strpattern & " is not a recognised RegEx pattern." Exit Sub End If If Not b_start Then b_start = True strReport = strReport & "Results" & vbCrLf End If If Not b_First And b_start Then strReport = strReport & vbCrLf & "In Table on Slide " & osld.SlideIndex & ": " b_First = True Else End If Set oMatch = regX.Execute(strInput) For i = 0 To oMatch.Count - 1 strReport = strReport & oMatch(i) & " / " Next i End If Next iCol Next iRow End If If oshp.HasTextFrame And Not oshp.HasTable Then If oshp.TextFrame.HasText Then strInput = oshp.TextFrame.TextRange.Text b_found = regX.Test(strInput) If b_found = True Then If Err <> 0 Then MsgBox strpattern & " is not a recognised RegEx pattern." Exit Sub End If If Not b_start Then b_start = True strReport = strReport & "Results" & vbCrLf End If If Not b_First And b_start Then strReport = strReport & vbCrLf & "On Slide " & osld.SlideIndex & ": " End If Set oMatch = regX.Execute(strInput) For i = 0 To oMatch.Count - 1 strReport = strReport & oMatch(i) & " / " Next i End If End If End If End Select b_First = False If Right(strReport, 2) = "/ " Then strReport = Left(strReport, Len(strReport) - 2) Next oshp Next osld iFileNum = FreeFile Open Environ("USERPROFILE") & "\Desktop\Abbr.txt" For Output As iFileNum Print #iFileNum, strReport Close iFileNum Call Shell("NOTEPAD.EXE " & Environ("USERPROFILE") & "\Desktop\Abbr.txt", vbNormalFocus) Set regX = Nothing End Sub
Looking forward for your valuable inputs. Thanks in advance for all your help.
Regards,
Satya
Reply With Quote
