At that point you should see the main dialog box of the DSCAN-UDM (or Tradiciel2001) macro:
If you press the buton UDM, the following code will launch the executable Udbman.exe delivered with DSCAN-UDM (Tradiciel).
You can change the code to call any other executable that you want.
 |
Private Sub ComLaunchUDM_Click()
Dim RetVal
Dim LaCommande As String
' Test if folder exists.
Set Folder = CreateObject("Scripting.filesystemobject")
If Folder.folderexists(TextPathDSCANUDM.Text) = "True" Then
With Application.FileSearch
Set fs = Application.FileSearch
fs.NewSearch
.FileName = "Udbman.exe"
.LookIn = TextPathDSCANUDM.Text
.Execute
If .FoundFiles.Count > 0 Then
If Tasks.Exists("DB Manager") = True Then
With Tasks("DB Manager")
.Activate
.WindowState = wdWindowStateNormal
End With
Else
TextPathDSCANUDM.Text = .LookIn 'remove the last \
'then add a \
LaCommande = TextPathDSCANUDM.Text & "\" & .FileName
R = Shell(LaCommande, 1)
Tasks("DB Manager").WindowState = wdWindowStateNormal
End If
End If
End With
End If
End Sub
|
You could for example highlight a word and search it in all your ASCII databases.
In this example the search is done on bilingual ASCII databases, but it could really be anything else (Address, phone numbers, email - Artists names, movie titles, description...).
Here is an example of a dialog box that displays all the User Database Records located after the search is done.
The user can double click the selected record to insert it in the Word Document.
(The code to search UDBs is just under)
 Note: Private Sub ListField2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Selection = ListField2.List(ListField2.ListIndex) ' When user double clicks, the text replaces the selection in the document Unload UserForm3fields ' then unload the form End Sub |
Sub GetSelectedText() ' Code to select highlighted text and use it as searchstring
Dim TextFromDocFile As String
Dim R
If Len(Selection) > 1 Then
' Get reference to the selected text.
SearchString = Selection ' get the text that is highlighted
If SearchString = "" Or SearchString = " " Then ' Check if the selected text is not only spaces.
R = MsgBox("Search String Not Valid (Empty).", vbInformation, "DSCAN-UDM")
Exit Sub
End If
Else
R = MsgBox("Select text in document.", vbInformation, "DSCAN-UDM")
Exit Sub
End If
If NombredUDBSelected < 1 Then 'Optional - Check if the user has selected at at least one UDB
UserFormSelectUDBs.Show ' if not ask to select UDB
Exit Sub
End If
SearchUDB SearchString
End Subd
|
Sub GetSentence()' Code to select a sentence and use it as searchstring Dim R Dim SearchString As String Selection.Collapse Selection.Extend Selection.Extend Selection.Extend Selection.MoveEndWhile Cset:=Chr(13), Count:=wdBackward Selection.MoveEndWhile Cset:=" ", Count:=wdBackward Selection.MoveEndWhile Cset:=".", Count:=wdBackward 'THIS NEXT LINE CAN BE UN-COMMENTED IF NEEDED 'Selection = Application.CleanString(Selection.Text) If Len(Selection) > 1 Then ' Get reference to the selected text. SearchString = Selection If SearchString = "" Or SearchString = " " Then R = MsgBox("Search String Not Valid (Empty).", vbInformation, "DSCAN") 'inform user Exit Sub End If Else R = MsgBox("Select text in document.", vbInformation, "DSCAN") 'inform user Exit Sub End If SearchUDB SearchString End Sub |
Sub SearchUDB(SearchString As String)
' Macro created 5/8/01 by Dominique G. Schneider
' This macro searches any selected text into User Databases in text format
' (can be used to translate any selected text with translation databases)
On Error GoTo mytrap
Dim Ltotal As Integer, P1 As Integer, P2 As Integer, Pos As Integer
Dim Testfeed As Integer, Testfeed2 As Integer, LKeep2 As Integer, LengthUDBField3 As Integer
Dim FileNumber As Integer, K As Integer
Dim AlreadyThere As Boolean, CanEnterIt As Boolean
Dim TestFilePresence As String, Letest As String
Dim SearchString As String, LignedeUDBLue As String, TempLignedeUDBLue As String, Msg As String
Dim UDBField1 As String, UDBField2 As String, UDBField3 As String
Dim R
If Len(TextFromDocFile) > 1 Then ' Check the length of the selected text.
SearchString = TextFromDocFile
If Trim(SearchString) = "" Then ' Check if the selected text is not only spaces.
MsgBox "Search String Not Valid (Empty)."
Exit Sub
End If
Else
R = MsgBox("Select text in Word document.", vbInformation, "DSCAN") 'inform user
Exit Sub
End If
If NombredUDBSelected > 0 Then ' check if the user has selected at least one UDB
For K = 0 To UBound(ArrayOfSelectedUDBs) - 1 ' loop through each selected UDB
UDB2Search = UDBPath & "\" & ArrayOfSelectedUDBs(K)
' this check is optional - In case user removed or rename a DB
TestFilePresence = UDB2Search
Letest = Dir(TestFilePresence)
If Len(Letest) = 0 Then
R = MsgBox("UDB " & UDB2Search & " not found.", vbInformation, "DSCAN") 'inform user
Exit Sub
End If
Dim I As Integer
I = 0
FileNumber = FreeFile ' Open DB
If Len(UDB2Search) Then
Open UDB2Search For Input As FileNumber
Do While (Not EOF(FileNumber)) 'Loop through the DB file line by line
DoEvents
Line Input #FileNumber, UDB_line 'read each db line
I = I + 1
Ltotal = Len(Trim(UDB_line))
If Ltotal > 0 Then
P1 = InStr(UDB_line, "`") ' search delimiter 1 - Field 1
P2 = InStr(P1 + 1, UDB_line, "`") ' search delimiter 2 - Field 2
If P1 < 1 Or P2 < 2 Then ' if not found... there is an error in DB... Exit
Msg = "Record :" + UDB_line + " Error." & Chr(10)
Msg = Msg & "Edit UDB or use UDM." & Chr(10)
R = MsgBox(Msg, vbCritical, "DSCAN")
Exit Sub
End If
Else
Msg = "Record # :" & I & " Empty." & Chr(10)
Msg = Msg & "Edit UDB or Use UDM to remove empty lines in " & UDB2Search
R = MsgBox(Msg, vbInformation, "DSCAN") 'inform user
Exit Sub
End If
' optional for case sensitive
TempUDB_line = UDB_line
If CaseInsentive = True Then
SearchString = LCase(SearchString)
TempUDB_line = LCase(TempUDB_line)
Else
End If
Testfeed = InStr(TempUDB_line, SearchString)
Testfeed2 = InStr(SearchString, TempUDB_line)
If Testfeed <= 0 And Testfeed2 <= 0 Then
CanEnterIt = False
Else
CanEnterIt = True
End If
If CanEnterIt = True Then 'feed array only if found
UDBField1 = Left(UDB_line, P1 - 1) 'keep only first part
LKeep2 = Ltotal - P2
UDBField3 = Right(UDB_line, LKeep2)
LengthUDBField3 = P2 - P1
UDBField2 = Mid(UDB_line, P1 + 1, LengthUDBField3 - 1)
If UserForm3fields.ListUDBField1.ListCount < 500 Then
If Filter4search = "" Then
UserForm3fields.ListUDBField1.AddItem UDBField1
UserForm3fields.ListField2.AddItem UDBField2
UserForm3fields.ListField3.AddItem UDBField3
Else
Testfeed = InStr(UDBField3, Filter4search)
If Testfeed > 0 Then
UserForm3fields.ListUDBField1.AddItem UDBField1
UserForm3fields.ListField2.AddItem UDBField2
UserForm3fields.ListField3.AddItem UDBField3
End If
End If
End If
End If
Loop
End If
Next K
Close
Else
R = MsgBox("You must select at least one UDB.", vbInformation, "DSCAN") 'inform user
UserFormSelectUDBs.Show
End If
If UserForm3fields.ListUDBField1.ListCount > 500 Then ' Optional - Let user know that first 500 records will be displayed
R = MsgBox("DSCAN will display the first 500 entries found.", vbInformation, "DSCAN")
UserForm3fields.Show
ElseIf UserForm3fields.ListUDBField1.ListCount > 0 And UserForm3fields.ListUDBField1.ListCount < 500 Then
UserForm3fields.Show
Else
'Optional if you want to inform user that string was not found in User Databases
'R = MsgBox("Demo: String not found in selected UDB(s)", vbInformation, "DSCAN")
UserFormEnterNewTrad.TextSource = SearchString
UserFormEnterNewTrad.Labelmesg.Caption = "String not found in selected UDB. Enter target string for UDB and/or document."
UserFormEnterNewTrad.Show
End If
mytrap:
Select Case Err
Case 0:
Case Else:
MsgBox "Error" & Err
Exit Sub
End Select
End Sub>
|
Sub GetSentencesOneByOne()' Code to select all the sentences one by one and use them as searchstring Dim LaPhraseEnCours As String ' SEARCH THE RANGE AND WORK ON ALL SENTENCES Dim iResponse As Integer 'THIS CODE IS MOSTLY USED BY TRANSLATORS TO AUTOMATE THE TRANSLATION Dim para As Paragraph 'SENTENCE BY SENTENCE Dim LaPhrase As Sentences Dim RangeTextATraduire As Range Dim R Dim NbrTotaldePhrase As Long 'SHOULD BE ENOUGH Dim I As Long Dim DoNotStartAtBegin As Boolean UserCanceledXlation = False 'START SEARCH STARTING AT LAST POSITION 'ALLOWING THE USER TO STOP AND RETURN TO THE DOCUMENT Dim bmBookMark As Bookmark For Each bmBookMark In ActiveDocument.Bookmarks If bmBookMark.Name = "DernierePositionDSCAN" Then Selection.GoTo What:=wdGoToBookmark, Name:=bmBookMark.Name ActiveDocument.Bookmarks.Item(bmBookMark.Name).Select Selection.EndKey Unit:=wdStory, Extend:=wdExtend Set RangeTextATraduire = ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument.Content.End) Selection.StartOf DoNotStartAtBegin = True End If Next ' SET THE RANGE IF DOCUMENT WAS NEVER ACCESSED WITH DSCAN-UDM If DoNotStartAtBegin = False Then Set RangeTextATraduire = ActiveDocument.Range End If With RangeTextATraduire ' REMEMBER NUMBER OF SENTENCES IN RANGE NbrTotaldePhrase = RangeTextATraduire.Sentences.Count ' LOOP THROUGH THE SENTENCES IN RANGE For I = 1 To NbrTotaldePhrase .Sentences(I).Select With .Sentences(I).TextRetrievalMode .IncludeHiddenText = False .IncludeFieldCodes = False End With ' Laderniere = RangeTextATraduire.Sentences.Last 'Selection = Application.CleanString(Selection.Text) Selection.MoveEndWhile Cset:=Chr(13), Count:=wdBackward Selection.MoveEndWhile Cset:=Chr(7), Count:=wdBackward Selection.MoveEndWhile Cset:=" ", Count:=wdBackward Selection.MoveEndWhile Cset:=Chr(46), Count:=wdBackward 'THE NEXT 3 LINES REMOVES THE END OF CELL MARKER If Selection.Information(wdWithInTable) Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1 End If If Trim(Selection) <> "" And Len(Selection) > 1 Then LaPhraseEnCours = Selection Traduire LaPhraseEnCours End If If UserCanceledXlation = True Then R = MsgBox("Do you want to stop or go to the next sentence?" & Chr$(13) & "Do you want to quit?" & Chr$(13) & "If you want to quit, click Yes.", vbYesNo) If R = "6" Then With ActiveDocument.Bookmarks Selection.Collapse Direction:=wdCollapseStart .Add Range:=Selection.Range, Name:="DernierePositionDSCAN" .DefaultSorting = wdSortByName .ShowHidden = False End With Exit For End If Else 'With ActiveDocument.Bookmarks ' .Add Range:=Selection.Range, Name:="LastSelectionPhraseDSCAN" ' .DefaultSorting = wdSortByName ' .ShowHidden = False 'End With End If Next I End With MsgBox prompt:="Search of translatable text is complete.", buttons:=vbInformation End Sub |