PDA

View Full Version : Removing the extra dots in word



thedark123
06-28-2006, 08:10 AM
This is my script that will generate this result:

Sub CommandButton1_Click()
' Example Macro to list the files contained in a folder.
'
Dim x As String, MyName As String
Dim i As Integer
Dim Response As Integer, TotalFiles As Integer
Dim counter As Integer
On Error Resume Next
Folder:
' Prompt the user for the folder to list.
x = InputBox(Prompt:="What folder do you want to list?" & vbCr & vbCr _
& "For example: C:\My Documents", _
Default:=Options.DefaultFilePath(wdDocumentsPath))
If x = "" Or x = " " Then
If MsgBox("Either you did not type a folder name correctly" _
& vbCr & "or you clicked Cancel. Do you want to quit?" _
& vbCr & vbCr & _
"If you want to type a folder name, click No." & vbCr & _
"If you want to quit, click Yes.", vbYesNo) = vbYes Then
Exit Sub
Else
GoTo Folder
End If
End If
' Test if folder exists.
If Dir(x, vbDirectory) = "" Then
MsgBox "The folder does not exist. Please try again."
GoTo Folder
End If
' Search the specified folder for files
' and type the listing in the document.
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeOfficeFiles
' Change the .FileType to the type of files you are looking for;
' for example, the following line finds all files:
' .FileType = msoFileTypeAllFiles
.LookIn = x
.Execute
TotalFiles = .FoundFiles.Count
If TotalFiles = 0 Then
MsgBox ("There are no files in the folder!" & _
"Please type another folder to list.")
GoTo Folder
End If
' Create a new document for the file listing.
Application.Documents.Add
ActiveDocument.ActiveWindow.View = wdPrintView
' Set tabs.
With Selection.ParagraphFormat.TabStops
.Add _
Position:=InchesToPoints(3), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
.Add _
Position:=InchesToPoints(4), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
End With


' Type the file list headings.
Selection.TypeText "File Listing of the "
With Selection.Font
.AllCaps = True
.Bold = True
End With
Selection.TypeText x
With Selection.Font
.AllCaps = False
.Bold = False
End With
Selection.TypeText " folder!" & vbLf



' Stop the screen flickering
'Application.ScreenUpdating = False
Application.ScreenUpdating = True

' Search for "Test Case ID:" and add 1 to counter
For i = 1 To TotalFiles
MyName = .FoundFiles(i)
Documents.Open FileName:=.FoundFiles(i)

With Selection.Find

.ClearFormatting
.Text = "Test Case ID:"

.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

.Forward = True
Do While .Execute(Forward:=True, Format:=True) = True
With .Parent
counter = counter + 1
If .End = ActiveDocument.Content.End Then
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter ":"
Exit Do
Else
.StartOf Unit:=wdParagraph, Extend:=wdMove
.InsertAfter ":"
.Move Unit:=wdParagraph, Count:=1
End If
End With
Loop
End With


' Initialise all variables for extra feature
Dim tcount As Integer
Dim y As Integer
Dim testid()
Dim rcount()
tcount = ActiveDocument.Tables.Count
y = 0
ReDim testid(tcount)
ReDim rcount(tcount)

For j = 0 To tcount
ActiveDocument.Tables(j).Select
With Selection.Find
.ClearFormatting
.Text = "Test Case ID:"
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

.Forward = True
Do While .Execute(Forward:=True, Format:=True) = True
With .Parent
testid(j) = ActiveDocument.Tables(j).Cell(1, 2).Range.Text

rcount(j) = ActiveDocument.Tables(j).Rows.Count - 4
End With
Loop
End With
Next j

ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

' Type results into table







' Type results from extra feature into table
For k = 0 To tcount
'Selection.TypeText vbTab & vbTab
Selection.TypeText testid(k) & vbTab & rcount(k) & vbLf


Next k
counter = 0
tcounter = 0
Next i

' Type the total number of files found.
Selection.TypeText vbLf & "Total files in folder = " & TotalFiles & _
" files."

'turn updating back on
Application.ScreenUpdating = True

End With
'If MsgBox("Do you want to print this folder list?", vbYesNo) = vbYes Then
'Application.ActiveDocument.PrintOut
'End If
If MsgBox("Do you want to list another folder?", vbYesNo) = vbYes Then
GoTo Folder
End If
End Sub






And this is the code to make the results display:

Selection.TypeText testid(k) & vbTab & rcount(k) & vbLf

Why is there a dot in between the sentence? How to remove it?

http://i6.photobucket.com/albums/y226/thedark123/dots.jpg

To make it to become this way

http://i6.photobucket.com/albums/y226/thedark123/dotsnice1.jpg

lucas
06-28-2006, 09:58 AM
looks like a bullet to me

fumei
06-28-2006, 10:37 AM
Will you PLEASE just post the relevant code.

And, as mentioned previously, if this is in a table (which i believe it is) STOP using Selection.TypeText.

START using explicit styles. This is a format issue, and you have all the tools you need - and have been told numerous times how to use them.

thedark123
06-29-2006, 05:40 AM
Solved thanks:

Do While .Execute(Forward:=True, Format:=True) = True
With .Parent
testid(j) = Left(ActiveDocument.Tables(j).Cell(1, 2).Range.Text, _
Len(ActiveDocument.Tables(j).Cell(1, 2).Range.Text) - 3)
rcount(j) = ActiveDocument.Tables(j).Rows.Count - 4
newname(j) = ActiveDocument.Name
End With
Loop
End With

mdmackillop
06-29-2006, 05:42 AM
Thanks for the solution. Please remember to insert line breaks in long lines of code.
Regards
MD