Sub Switch_first()
'Developer: Eslam Abdullah
Dim o$, n$, x&, y%, rng: rng = Selection
o = InputBox("Enter the old char (?)", "Switch first character")
If StrPtr(o) = 0 Then GoTo ext Else If Len(o) <> 1 Then GoTo msg
n = InputBox("Enter the new char (?)", "Switch first character")
If StrPtr(n) = 0 Then GoTo ext Else If Len(n) <> 1 Then GoTo msg
With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = "(^|s)" & o
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = LTrim(.Replace(rng(x, y), " " & n)): Next: Next
Selection = rng
End With
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
ext: Exit Sub
msg: MsgBox "Only one char", 16, "Auditor: Eslam Abdullah"
End Sub
'-----------------------------------------------------------------------------
Sub Switch_last()
'Developer: Eslam Abdullah
Dim o$, n$, x&, y%, rng: rng = Selection
o = InputBox("Enter the old char (?)", "Switch last character")
If StrPtr(o) = 0 Then GoTo ext Else If Len(o) <> 1 Then GoTo msg
n = InputBox("Enter the new char (?)", "Switch last character")
If StrPtr(n) = 0 Then GoTo ext Else If Len(n) <> 1 Then GoTo msg
With CreateObject("VBScript.RegExp"): .Global = True: .Pattern = o & "($|s)"
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = RTrim(.Replace(rng(x, y), n & " ")): Next: Next
Selection = rng
End With
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
ext: Exit Sub
msg: MsgBox "Only one char", 16, "Auditor: Eslam Abdullah"
End Sub
'-----------------------------------------------------------------------------
Sub Trim_Spaces()
'Developer: Eslam Abdullah
Dim x&, y%, rng: rng = Selection
If Not IsArray(rng) Then ReDim rng(1 To 1, 1 To 1): rng(1, 1) = Selection
For x = 1 To UBound(rng, 1): For y = 1 To UBound(rng, 2)
rng(x, y) = Application.Trim(rng(x, y)): Next: Next
Selection = rng
MsgBox "Done", 64, "Auditor: Eslam Abdullah"
End Sub
[1]
توحيد بداية ونهاية كل كلمة
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
