atw: Re: austechwriter Digest V1 #194 - VBA GURU... (not quite)
- From: Carlos Mills <Carlos_Mills@xxxxxxxxxxx>
- To: austechwriter@xxxxxxxxxxxxx
- Date: Mon, 13 Oct 2003 14:23:29 +1000
Hi Melanie
I have a suggested code for you below, of course you can optimise it... but
works.
----- CODE W4W VBA
Sub StripMacro()
'
' StripMacro Macro
' Macro recorded 13/10/2003 by Carlos Mills
' Take the text from a selection and place it in a variable.
' Strip the spaces, question marks, etc, from the variable
' and pass the result to another variable.
Dim var1, var2 As String
Dim pos As Long
Dim var1Len As Long
Dim i As Long
'You need to place the code on how to find your text
'<<<<< CODE >>>>>>>>
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
'Store selected text in a variable removimg spaces
var1 = Trim(Selection.Text)
var1Len = Len(var1)
'Remove carriage return if end of line
If Right(var1, 1) = vbCr Then
var1 = Left(var1, var1Len - 1)
End If
'update text lenght
var1Len = Len(var1)
'store the string lenght
'scan selected text for special chars
pos = InStr(1, var1, "?")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "!")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "@")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "#")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "%")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "/")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "<")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, ">")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "[")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "]")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "{")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "}")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, "(")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'update text lenght
var1Len = Len(var1)
pos = InStr(1, var1, ")")
If pos > 0 Then
var1 = Left(var1, pos - 1) & Right(var1, var1Len - (pos + 1))
End If
'Pass the results to another variable (Why?)
var2 = var1
End Sub
--------END CODE
Enjoy
Carlos Mills
Technical Writer
VB Programmer
Web Designer
URL: http://users.bigpond.com/carlos_mills/
e-mail: carlos_mills@xxxxxxxxxxx
-----Original Message-----
From: FreeLists Mailing List Manager [mailto:ecartis@xxxxxxxxxxxxx]
Sent: Wednesday, 8 October 2003 5:04 PM
To: austechwriter digest users
Date: Wed, 08 Oct 2003 13:41:26 +1000
From: "melanie.kendell" <melanie.kendell@xxxxxxxxxxx>
Subject: stripping spaces etc from a variable in VBA
Hi VBA gurus
I remember doing this before (I also remember I had trouble figuring it out
last time) but I'm having a mental blank.
What I want to do is this:
Take the text from a selection and place it in a variable.
Strip the spaces, question marks, etc, from the variable and pass the result
to another variable.
I do not want the selected text in the document to change.
Any ideas?
-Melanie
------------------------------
-- Binary/unsupported file stripped by Ecartis --
-- Type: application/ms-tnef
-- File: winmail.dat
**************************************************
To post a message to austechwriter, send the message to
austechwriter@xxxxxxxxxxxxxx
To subscribe to austechwriter, send a message to
austechwriter-request@xxxxxxxxxxxxx with "subscribe" in the Subject field.
To unsubscribe, send a message to austechwriter-request@xxxxxxxxxxxxx with
"unsubscribe" in the Subject field.
To search the austechwriter archives, go to
www.freelists.org/archives/austechwriter
To contact the list administrator, send a message to
austechwriter-admins@xxxxxxxxxxxxx
**************************************************
Other related posts:
