gmaxey
03-05-2017, 08:03 AM
Mana from Japan, I hope you see this question as it is related to a thread that you participated in last week.
http://www.vbaexpress.com/forum/showthread.php?58755-Particular-cut-paste-and-replace-for-red-text
While I dabble in VBA with Word mostly and occasionally in Excel an Outlook, I do not consider myself a programmer. Far from it. In fact, normal programming languages such as C+, Java, VB, .Net is to me for the most part a riddle wrapped in a mystery inside a enigma.
I had tinkered with the problem for a few minutes in the morning before headed out to school and thought that I would try to solve it using a scripting dictionary. The code below shows how I would have done that. However, when I saw your use of the .NET ArrayList, I became intrigued and thought I would see where I could take it and started researching it a bit.
I thought that if it worked ArrayList worked so well in a VBA then perhaps a .NET DictionaryBase might work as well. No luck. For whatever reason, CreateObject("System.Collections.DictionaryBase") errors and while CreateObject("System.Collections.HashTable") doesn't error, the methods don't seem to work.
Do you (or anyone) know if the .NET DictionaryBase or HashTable can work in VBA?
Thanks.
Sub ScrathcMacro()
'A basic Word macro code by Greg Maxey.
Dim oRng As Range, oRgSegment As Range
Dim oDictionary As Object
Dim lngIndex As Long
Dim strText As String
If Not Len(ActiveDocument.Range.Paragraphs.Last.Range) = 1 Then
ActiveDocument.Range.Paragraphs.Last.Range.InsertAfter vbCr
End If
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseStart
Set oDictionary = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Do
lngIndex = 0
Do
oRng.MoveEnd wdParagraph
Loop Until Len(oRng.Paragraphs.Last.Range) = 1
Set oRgSegment = oRng.Duplicate
With oRgSegment.Find
.Font.Color = wdColorRed
Do While .Execute
If Not oRgSegment.InRange(oRng) Then Exit Do
oDictionary.Add fcnIntergerToLetter(lngIndex), oRgSegment.Text
With oRgSegment
.Text = ".........."
.Font.Color = wdColorAutomatic
.Collapse wdCollapseEnd
End With
lngIndex = lngIndex + 1
Loop
End With
strText = vbNullString
For lngIndex = 0 To oDictionary.Count - 1
strText = strText & "%" & oDictionary.Keys()(lngIndex) & ". " & oDictionary.Item(oDictionary.Keys()(lngIndex))
Next
With oRng
.Paragraphs.Last.Range.Text = vbCr & strText & vbCr + vbCr
.Collapse wdCollapseEnd
.Move wdParagraph, 3
End With
oDictionary.RemoveAll
Loop Until oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Function fcnIntergerToLetter(lngCount As Long)
If lngCount = 0 Then
fcnIntergerToLetter = "a"
Else
If lngCount < 26 Then
fcnIntergerToLetter = LCase(Chr(lngCount + 1 + 64))
Else
fcnIntergerToLetter = "Error"
End If
End If
End Function
http://www.vbaexpress.com/forum/showthread.php?58755-Particular-cut-paste-and-replace-for-red-text
While I dabble in VBA with Word mostly and occasionally in Excel an Outlook, I do not consider myself a programmer. Far from it. In fact, normal programming languages such as C+, Java, VB, .Net is to me for the most part a riddle wrapped in a mystery inside a enigma.
I had tinkered with the problem for a few minutes in the morning before headed out to school and thought that I would try to solve it using a scripting dictionary. The code below shows how I would have done that. However, when I saw your use of the .NET ArrayList, I became intrigued and thought I would see where I could take it and started researching it a bit.
I thought that if it worked ArrayList worked so well in a VBA then perhaps a .NET DictionaryBase might work as well. No luck. For whatever reason, CreateObject("System.Collections.DictionaryBase") errors and while CreateObject("System.Collections.HashTable") doesn't error, the methods don't seem to work.
Do you (or anyone) know if the .NET DictionaryBase or HashTable can work in VBA?
Thanks.
Sub ScrathcMacro()
'A basic Word macro code by Greg Maxey.
Dim oRng As Range, oRgSegment As Range
Dim oDictionary As Object
Dim lngIndex As Long
Dim strText As String
If Not Len(ActiveDocument.Range.Paragraphs.Last.Range) = 1 Then
ActiveDocument.Range.Paragraphs.Last.Range.InsertAfter vbCr
End If
Set oRng = ActiveDocument.Range
oRng.Collapse wdCollapseStart
Set oDictionary = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Do
lngIndex = 0
Do
oRng.MoveEnd wdParagraph
Loop Until Len(oRng.Paragraphs.Last.Range) = 1
Set oRgSegment = oRng.Duplicate
With oRgSegment.Find
.Font.Color = wdColorRed
Do While .Execute
If Not oRgSegment.InRange(oRng) Then Exit Do
oDictionary.Add fcnIntergerToLetter(lngIndex), oRgSegment.Text
With oRgSegment
.Text = ".........."
.Font.Color = wdColorAutomatic
.Collapse wdCollapseEnd
End With
lngIndex = lngIndex + 1
Loop
End With
strText = vbNullString
For lngIndex = 0 To oDictionary.Count - 1
strText = strText & "%" & oDictionary.Keys()(lngIndex) & ". " & oDictionary.Item(oDictionary.Keys()(lngIndex))
Next
With oRng
.Paragraphs.Last.Range.Text = vbCr & strText & vbCr + vbCr
.Collapse wdCollapseEnd
.Move wdParagraph, 3
End With
oDictionary.RemoveAll
Loop Until oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Function fcnIntergerToLetter(lngCount As Long)
If lngCount = 0 Then
fcnIntergerToLetter = "a"
Else
If lngCount < 26 Then
fcnIntergerToLetter = LCase(Chr(lngCount + 1 + 64))
Else
fcnIntergerToLetter = "Error"
End If
End If
End Function