Auto create abbreviation list..

[spsanu]

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 :clap::clap:

VBA Code is:


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




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.

Looking forward for your valuable inputs. Thanks in advance for all your help.

Regards,
Satya

[Paul_Hossler]

Welcome to VBAexpress

Please use the [#] icon to add [ CODE ] and [ /CODE ] tags and paste your macro(s) between them to set them off and format for easier reading

Also looks like the macro got pasted in twice, so I deleted the second copy for clarity and to avoid confusion

[spsanu]

Thanks for your reply Paul and sorry for the confusion, please find below the correct code:


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 reply. Thanks

[John Wilson]

I'm the original author. http://www.pptalchemy.co.uk/PowerPoint_RegEx.html

The line of code that determines what is found is the line that sets strpattern

Change that line to


strpattern = "\b[A-Z(.)?]{2,}\b" 'CAPS with optional . not digit that should do it.

If you want to find e.g. C2 or ITV4 but NOT 123 then try


strpattern = "\b[A-Z(.)]{1,}\d?\b"

[spsanu]

Hi John,

Thanks a lot!! This code going to save lot of time, thanks again.

I am little new to power point VBA, if possible can you please suggest me how to make this as add-in. I have tried by saving the file as .ppam and try to open the add-in in different PPT file, however, in spite of adding this add-in to PPT, I could not able to see it in menu bar. Not sure what I am doing wrong.
Thanks & Regards,
Satya Prakash

[John Wilson]

You would need to add XML to create a ribbon button. There is a very basic tutorial on our site.
http://www.pptalchemy.co.uk/custom_UI.html

[spsanu]

Hi John,

Thanks for reply again.

I have started using your code, however, after updating the code with "\b[A-Z(.)]{1,}\d?\b"" or ""\b[A-Z(.)?]{2,}\b" power point does not recognise any abbreviation which start from CAPITALS and has number in between for example B2B or CIQ3 also any abbreviation given in any table. Please find below the example slide:
18362

If I use you original code, I would get all the abbreviation (within table and text) along with number which I dont want , however, if I modify the code then I won't get numbers but also I won't get any abbreviation given in table also abbreviation that contains number as well.

I Would really appreciate if you please help me understand, if there is any possibility to update your original code which gives me all abbreviation given in text and table without any numbers.

Thanks a lot for you help till now.

Regards,
Satya

[John Wilson]

You could try using this pattern after that it is time to start Googling for RedX patterns!

strpattern = "\b[A-Z][A-Z(.\d)?(A-Z)?]{2,}\b"