Code:
' http://www.excelforum.com/the-water-cooler/1103850-extra-space-or-spaces-in-text-in-forum-post-bb-code-for-extra-space-2.html
Sub AlanHansClipboardTextGetFindReplace() 'Using the "Dialogue Find Replace" way. http://www.eileenslounge.com/viewtopic.php?f=26&t=22603
Rem 1) Put Selected Text in Clipboard.
'Dim objCliS As dataobject '**Early Binding. Object from the class MS Forms, This is for an Object from the class MS Forms. This will be a Data Object of what we "send" to the Clipboard. It has the Methods I need to send text to the Clipboard. I will use this to put Things in the Clipboard. Bringing things out I will do with another Data Object
'Set objCliS = New dataobject '**Must enable Forms Library: In VB Editor do this: Tools -- References - scroll down to Microsoft Forms 2.0 Object Library -- put checkmark in. Note if you cannot find it try OR IF NOT THERE..you can add that manually: VBA Editor -- Tools -- References -- Browse -- and find FM20.DLL file under C:\WINDOWS\system32 and select it --> Open --> OK.
' ( or instead of those two lines Dim obj As New DataObject which is the same ). or next two lines are...
Dim objCliS As Object ' ...Late Binding equivalent'
Set objCliS = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
Dim Txtin As String: Let Txtin = Selection.Text: Debug.Print Txtin 'Copies the selection as a continuous string: Hit Ctrl G to see it in the Immediate window! You will see it with carriage returns , the Copmuter just sees it as a long "Horizontal" string
objCliS.SetText Txtin 'Make object's text equal above string variable
objCliS.PutInClipboard 'Place current object dataObject into the Clipboard ( Our original selected text ....!!!.... is in that )
'Rem 2) 'Bit of a bodge to get the text in a selection: create a Word file and paste to it
Dim FullFilePathAndFullName As String 'Initial Pigion Hole given for this String variable, and given a special vbNullString "Value", theoretically to simplify comparisons.
Documents.Add: ActiveDocument.Content.Paste 'Make a File Copy in current Application based on Default Type : And Paste from Clipoard ( ...!!!...our original selected text ) using the Default Copy which should at least have all the text, which is all we are interested in here.
ActiveDocument.SaveAs Filename:="TempBBCodeCopyTidledInSpaces.docx", FileFormat:=wdFormatXMLDocument 'Without this the document will not really "exist jet". It has a temporary name ( Used in Windows referrence ), but no path.
Let FullFilePathAndFullName = ActiveDocument.Path & "\" & ActiveDocument.Name
Selection.WholeStory 'Selects whole document which here is just our selection of interest from the oroiginal document
'Rem 3) Han's Text Find Replacement Dialogue 'http://www.eileenslounge.com/viewtopic.php?f=26&t=22603#p175712
With Selection.Find 'This is the VBA code ( or very similar ) used by Excel when Using the Find eplace text Dialogue box. So this is an improved version of what a macro recording would give.
.ClearFormatting: .Replacement.ClearFormatting ' Don't use formating, ? not sure this comes into the equation ??
.Wrap = wdFindStop ' Tell Word not to continue past the end of the selection ( And therefore prevents also a display Alert asking )
.MatchWildcards = False ' Don't use wildcards. The default anyway, but in this code is an important concept...
.Text = " " ' Search text is two spaces
.Replacement.Text = "~~" ' Replace text is with two tildas.
.Execute Replace:=wdReplaceAll ' Replace all within selection. This is the "OK" button!
.Text = "~ " ' Search text is tilda followed by space
.Execute Replace:=wdReplaceAll ' Replace all within selection. This is the "OK" button!
.Text = "~{1;}" 'or [~]{1;} It is still not totally clear whether this is a Reg Ex Pattern or a Wild Card String. Important is that it is a String in a Dialogue to be applied to A ( Word in this case ) document. Sort of as you write in a cell, so the ; , convention must be carefully checked and appropriately used here
'.Text = "~{1,}" ' English XL !!!! *********
' .Replacement.Text = "^&" ' Enclose in BB codes ...... This "Wildcard" applies only to the Replace. It inserts the found string, or strings.
.Replacement.Text = "^&" ' Enclose in BB codes ...... This "Wildcard" applies only to the Replace. It inserts the found string, or strings.
.MatchWildcards = True 'The next line does the Replce, here we are still selecting an option,( Use wildcards )
.Execute Replace:=wdReplaceAll ' Replace all within selection. This is the "OK" button!
End With
ActiveDocument.Select 'Re select the...( actually this line alone seems to do it )
Selection.WholeStory '...while document
Rem 4) "Reset the "Find Replace Text Dialogue" "Thing" "
With Selection.Find
.ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "": .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
End With
Rem 4.5) Bodge due to Forum "Eating a carriage Return sometimes" . Seems to occur when I paste first in Word, then copy that to Forum. Direct to Forum seems OK.
Dim TextAndvbLf As String
Let TextAndvbLf = Selection.Text: Let TextAndvbLf = Replace(TextAndvbLf, vbCr, vbCr & vbLf, 1, -1)
Rem 5) Final result to and from Clipboard
'5b) Using again objCliS we put the modified text in the Clipboard, so overwritng the original
objCliS.SetText TextAndvbLf 'Replace the text in the data object
objCliS.PutInClipboard 'Place current object dataObject into the Clipboard, so putting the modified text in there
'5b) Another data Object to get the data from the clipboard.
'Dim objDat As dataobject
'Set objDat = New dataobject 'Set to a new Instance ( Blue Print ) of dataobject
Dim objDat As Object
Set objDat = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDat.GetFromClipboard 'All that is in the Clipboard goes in this Data Object second instance of the Class.
Dim TxtOut As String: Let TxtOut = objDat.GetText() 'retrieve the text in this second instance of the Class. ( In this case all I have in it is the text )
MsgBox prompt:="You dumped in Clipboard this " & vbCr & objCliS.GetText() & vbCr & "and if you try to get it, you should get" & vbCr & TxtOut & ""
Rem 6) Optional to delete Temporary File
ActiveDocument.Close (wdDoNotSaveChanges) 'Giving the option will also prevent being asked for it. You must close. VBA will not let you kill an open sheet, as you are affectively working on a copy, and VBA is assumng the Original can be got at by saving for example. http://www.mrexcel.com/forum/excel-questions/920451-excel-macro-files.html#post4425428
Kill FullFilePathAndFullName 'Use the Kill wisely!!!! - where this goes there 'aint no coming back!!
Rem 6)
Set objCliS = Nothing: Set objDat = Nothing 'Probably do not need to do this.... http://www.excelforum.com/excel-programming-vba-macros/1148945-trying-to-name-a-range-what-am-i-doing-wrong-2.html#post4465632
End Sub
Bookmarks