[VBS HTA] Code entre 2 fichiers Texte => 2 TextBox.

Invité · 22/11/2017, 10h15

Bonjour,
Le code ci-dessous travail sur 2 fichiers Texte.
Pourriez-vous m'aider à l'adapter pour un travail entre 2 TextBox d'un HTA ?

A savoir que je n'aurais qu'une seule ligne dans mes textbox

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Const ForReading = 1, ForWriting = 2
 
strScriptFile = Wscript.ScriptFullName 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strScriptFile) 
strFolder = objFSO.GetParentFolderName(objFile)
 
' Replace
Set objFile = objFSO.OpenTextFile(strFolder & "\replace_this_text.txt", ForReading)
 
Do
   strLine = strLine & objFile.ReadLine & vbCrLf        
Loop While Not objFile.AtEndOfStream
 
objFile.Close
 
' Remove last ENTER added by Loop
 
strLine = Left(strLine, Len(strLine) - 2)
 
strLine = Replace_Char(strLine)
 
' Saving new file, with replaced text.
If Not (objFSO.FileExists(strFolder & "\replaced.txt")) Then
    objFSO.CreateTextFile(strFolder & "\replaced.txt")
End If
 
Set objFile = objFSO.OpenTextFile(strFolder & "\replaced.txt", ForWriting)
 
objFile.Write(strLine)
 
objFile.Close
 
WScript.Echo strLine

Invité · 22/11/2017, 15h37

Re Bonjour,
Voici le code que j'aimerais porter sous HTA en utilisant 2 TextBox à la place des 2 fichiers texte.

Mon fichier "replace_this_text.txt" contient : paquetsÿ; envoy‚s = 40, re‡us = 40-

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
'WScript.Echo Replace_Char("Remplacement de caractères.")
'##########################################################
Function Replace_Char(strRemove)
 
    Dim Array_CharS(1)
    Dim arrReplace(5)
    Dim arrReplaceWith(5)
 
    Array_CharS(0) = arrReplace
    Array_CharS(1) = arrReplace
 
    ' Replace
    Array_CharS(0)(0) = "‡"
    Array_CharS(0)(1) = "ÿ"
    Array_CharS(0)(2) = "‚s"
    Array_CharS(0)(3) = "p"
    Array_CharS(0)(4) = ";"
    Array_CharS(0)(5) = "-"
 
     ' With
    Array_CharS(1)(0) = "ç"
    Array_CharS(1)(1) = ""
    Array_CharS(1)(2) = "ès"
    Array_CharS(1)(3) = "P"
    Array_CharS(1)(4) = ":"
    Array_CharS(1)(5) = "."
 
    WScript.Echo "Remove str: " & strRemove
    For N = 0 To 5
 		' WScript.Echo "Replace " & Array_CharS(0)(N) & " with " & Array_CharS(1)(N)
        ' 1: Commence à partir du 1er caractère trouvé.
        ' -1: Recherche tant que la chaine n'est pas terminée.
        ' 0: Comparision. Respectez majuscules et minuscules.
        strRemove = Replace(strRemove, Array_CharS(0)(N), Array_CharS(1)(N), 1, -1, 0)
    Next
 
    Replace_Char = strRemove
 
 
End Function
'##########################################################
 
Const ForReading = 1, ForWriting = 2
 
strScriptFile = Wscript.ScriptFullName 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strScriptFile) 
strFolder = objFSO.GetParentFolderName(objFile)
 
Set objFile = objFSO.OpenTextFile(strFolder & "\replace_this_text.txt", ForReading)
 
Do
   strLine = strLine & objFile.ReadLine & vbCrLf        
Loop While Not objFile.AtEndOfStream
 
objFile.Close
 
' Remove last ENTER added by Loop
' http://blogs.technet.com/b/heyscriptingguy/archive/2005/05/20/how-can-i-remove-the-last-carriage-return-linefeed-in-a-text-file.aspx
strLine = Left(strLine, Len(strLine) - 2)
 
strLine = Replace_Char(strLine)
 
If Not (objFSO.FileExists(strFolder & "\replaced.txt")) Then
    objFSO.CreateTextFile(strFolder & "\replaced.txt")
End If
 
Set objFile = objFSO.OpenTextFile(strFolder & "\replaced.txt", ForWriting)
 
objFile.Write(strLine)
 
objFile.Close
 
WScript.Echo strLine

Franchement je patauge sur la gestion :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

strLine = Replace_Char(strLine)

Pourriez-vous m'aider?

**ProgElecT** · 22/11/2017, 17h29

Salut
Avec cette base Fonction qui supprime les accents des caractères, j'ai bidouillé çà

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function Corriger(TextAtraiter)
Dim RegularExpressioN, T, U
Dim ListPattern, TblPattern
Dim ListSubstit, TblSubstit
 
'création du tableau de Pattern en 2 étapes
'       1er étape: création de la liste caractères exotiques
ListPattern = "p|ÿ|‚|‡|;|-"
'       2éme étape: création du tableau de Pattern
TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
 
'création du tableau de substitution des caractères exotique en caractères codés ANSI
ListSubstit = "P| |é|ç|:|."   ' création de la liste
TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare) ' création du tableau
 
Set RegularExpressioN = New RegExp 'VBScript Regular Expressions et natif sous VBScript
RegularExpressioN.Global = True 'appliquer le remplacement à tout le texte
Corriger = TextAtraiter
U = UBound(TblPattern)
For T = 0 To U
    RegularExpressioN.Pattern = TblPattern(T) 'caractère(s) à rechercher
    ' Effectue le remplacement appliquer à tout le texte
    Corriger = RegularExpressioN.Replace(Corriger, TblSubstit(T))
Next
 
Set RegularExpressioN = Nothing
End Function

Essais avec cette fonction (en remplacement de la tienne Replace_Char), ta ligne strLine = Replace_Char(strLine) devient strLine = Corriger(strLine)

Invité · 22/11/2017, 18h30

Salut,
Cette fonction est vraiment intéressante, RegExp + Tableau.
Merci pour cette adaptation.

Invité · 26/11/2017, 22h11

Bonsoir,
Une idée sur la possibilité de gérer un 2eme tableau de substitution selon si mon CheckBox et actif ou non ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
  APPLICATIONNAME="My HTML application"
  ID="MyHTMLapplication"
  VERSION="1.0"/>
</head>
 
<script language="VBScript">
 
Sub GetCheckBox1Value()
  If CheckBox1.checked Then
    MsgBox "CheckBox1 is checked"
  Else
    MsgBox "CheckBox1 is Unchecked"
  End if
End Sub
 
Function Corriger(TextAtraiter)
Dim RegularExpressioN, T, U
Dim ListPattern, TblPattern
Dim ListSubstit, TblSubstit
 
 
'Création de la liste des caractères a rechercher.
ListPattern = "p|ÿ|‚|‡|;|-"
'Création du tableau de Pattern.
TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
 
'Création de la liste des caractères de substitution.
ListSubstit = "P||é|ç|:|."
'création du tableau de substitution.
TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)
 
'################# ListSubstit2 #####################################################################################
'Création de la liste des caractères de substitution.
ListSubstit2 = "(P)|_|e|c|=|:"
'création du tableau de substitution.
TblSubstit2 = Split(ListSubstit2, "|", -1, vbTextCompare)
'##############################################################################################################
 
Set RegularExpressioN = New RegExp
'Appliquer le remplacement à tout le texte
RegularExpressioN.Global = True 
Corriger = TextAtraiter
U = UBound(TblPattern)
For T = 0 To U
    RegularExpressioN.Pattern = TblPattern(T) 'caractère(s) à rechercher
    ' Effectue le remplacement appliquer à tout le texte
    Corriger = RegularExpressioN.Replace(Corriger, TblSubstit(T))
Next
 
Set RegularExpressioN = Nothing
End Function
 
 
Sub TestSub
	GetCheckBox1Value
    strText = MyTextArea.Value' = "paquetsÿ; envoy‚s = 40, re‡us = 40-"
	'Msgbox strText	
	strText = Corriger(strText)	
	'Msgbox strText
	TextResult.Value = strText
End Sub
 
</script>
 
<body bgcolor="white">
	<input type="checkbox" name="CheckBox1" id="CheckBox1" onclick="GetCheckBox1Value" checked=true>CheckBox1<P>
    <input type="text" name="MyTextArea" value="paquetsÿ; envoy‚s = 40, re‡us = 40-" size="50"><P>
    <input type="text" name="TextResult" size="50"><P>
    <input type="button" value="Run Script" onClick="TestSub">
</body>
</html>

**ProgElecT** · 27/11/2017, 10h24

Salut

Je te propose plutôt des boutons radio, ce qui te permettra d'avoir 2 substitutions ou plus ligne 18 à 24.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
<html>
	<head>
		<title> My HTML application </title>
		<HTA:APPLICATION
		APPLICATIONNAME="My HTML application"
		ID="MyHTMLapplication"
		VERSION="1.0" >
	</head>
 
<!-- ------------------------------------------------------------------------------------------------------------------------------ -->
<script language="VBScript">
	'----------------------------------------------------------------------------------------------------------------------
	Function Corriger(TextAtraiter)
	Dim RegularExpressioN, T, U
	Dim ListPattern, TblPattern
	Dim ListSubstit, TblSubstit
 
		If BtRadio(0).CHECKED Then
			ListPattern = "p|ÿ|‚|‡|;|-" 'Création de la liste des caractères a rechercher.
			ListSubstit = "P||é|ç|:|." 'Création de la liste des caractères a substituer au Pattern.
			Else
			ListPattern = "(P)|_|e|c|=|:" 'Création de la liste des caractères a rechercher.
			ListSubstit = "P||é|ç|:|." 'Création de la liste des caractères a substituer au Pattern.
		End if
		TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
		TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)
 
		Set RegularExpressioN = New RegExp
		'Appliquer le remplacement à tout le texte
		RegularExpressioN.Global = True 
		Corriger = TextAtraiter
		msgbox "coucou " & TextAtraiter
		U = UBound(TblPattern)
		For T = 0 To U
			RegularExpressioN.Pattern = TblPattern(T) 'caractère(s) à rechercher
			' Effectue le remplacement appliquer à tout le texte
			Corriger = RegularExpressioN.Replace(Corriger, TblSubstit(T))
		Next
 
	Set RegularExpressioN = Nothing
	End Function
 	'----------------------------------------------------------------------------------------------------------------------
	Sub TestSub
		strText = MyTextArea.Value
		'Msgbox strText	
		strText = Corriger(strText)	
		'Msgbox strText
		TextResult.Value = strText
	End Sub
</script>
<!-- ------------------------------------------------------------------------------------------------------------------------------ -->
 
<body bgcolor="white">
	<input type="radio" name="BtRadio" id="BtRadio1" CHECKED > <label for="BtRadio1" > ListSubstit1 </label>
	<input type="radio" name="BtRadio" id="BtRadio2" > <label for="BtRadio2" > ListSubstit2 </label>
	<p>
	<input type="text" name="MyTextArea" value="paquetsÿ; envoy‚s = 40, re‡us = 40-" size="50"><P>
    <input type="text" name="TextResult" size="50"><P>
    <input type="button" value="Run Script" onClick="TestSub">
</body>
</html>

[VBS HTA] Code entre 2 fichiers Texte => 2 TextBox.

VBScript

Vue hybride

Discussions similaires

Partager

Partager