[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>

Invité · 27/11/2017, 11h04

Salut
Je me suis mal exprimé, en fait c'est 2 tableaux de substitutions pour un même pattern, C'est pour cela que j'avais pensé au checkBox.
J'ai modifié dans un 1er temps comme ceci:

Code :

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

1
2
3
4
5
6
7
		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|ÿ|‚|‡|;|-" 'Création de la liste des caractères a rechercher.
			ListSubstit = "(P)|_|e|c|=|:" 'Création de la liste des caractères a substituer au Pattern.
		End if

Je pense qu'il est possible de déclarer qu'une seul fois le pattern non?

**ProgElecT** · 27/11/2017, 11h50

Ok, donc

Code :

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

1
2
3
4
5
6
7
8
		ListPattern = "p|ÿ|‚|‡|;|-" 'Création de la liste des caractères a rechercher.
		TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
		If BtRadio(0).CHECKED Then
			ListSubstit = "P| |é|ç|:|." 'Création de la liste des caractères a substituer au Pattern.
			Else
			ListSubstit = "(P)|_|e|c|=|:" 'Création de la liste des caractères a substituer au Pattern.
		End if
		TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)

Attention tout de même à avoir autant d'index dans TblSubstit que dans TblPattern car il y a la boucle For T = 0 To U ou U = UBound(TblPattern).

Invité · 27/11/2017, 17h04

J'ai un petit souci avec la version initiale que tu as proposé "Poste #3"
Plus de 25 caractères semble poser problème!

Code :

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

1
2
3
4
5
6
7
8
9
'Création de la liste des caractères a rechercher.
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y" '|z"
'Création du tableau de Pattern.
TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
 
'Création de la liste des caractères de substitution.
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]" '|[a-z]"
'création du tableau de substitution.
TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)

**ProgElecT** · 27/11/2017, 17h22

Il doit y avoir une erreur ailleurs car

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'Création de la liste des caractères a rechercher.
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|A|B"
'Création du tableau de Pattern.
TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
 
'Création de la liste des caractères de substitution.
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
'création du tableau de substitution.
TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)
 
msgbox len(ListPattern) ' ---> 55 caractères
msgbox len(ListSubstit) ' ---> 167 caractères
msgbox UBound(TblPattern) ' ---> 27 indexations
msgbox UBound(TblSubstit) ' ---> 27 indexations

fonctionne chez moi

Invité · 27/11/2017, 18h55

Cher moi si je mets dans mon MyTextArea :
abcdefghijklmnopqrstuvwxyzAB

J’obtiens :
[a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-z][a-z][a-z]

Au lieu de :
[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]

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
<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
 
'Création de la liste des caractères a rechercher.
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z|A|B"
'Création du tableau de Pattern.
TblPattern = Split(ListPattern, "|", -1, vbTextCompare)
 
'Création de la liste des caractères de substitution.
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
'création du tableau de substitution.
TblSubstit = Split(ListSubstit, "|", -1, vbTextCompare)
 
msgbox len(ListPattern)
msgbox len(ListSubstit)
msgbox UBound(TblPattern)
msgbox UBound(TblSubstit)
 
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
    strText = MyTextArea.Value
	'Msgbox strText	
	strText = Corriger(strText)	
	'Msgbox strText
	MyTextResult.Value = strText
End Sub
 
</script>
 
<body bgcolor="white">
    <input type="text" name="MyTextArea" size="50"><P>
    <input type="text" name="MyTextResult" size="250"><P>
    <input type="button" value="Run Script" onClick="TestSub">
</body>
</html>

Invité · 27/11/2017, 22h50

Le plus étrange c’est qu’avec A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z en ListPattern
et ABCDEFGHIJKLMNOPQRSTUVWXYZ renseigné dans mon TextBox MyTextArea cela fonctionne.

Je ne comprends vraiment pas d’où vient le problème avec abcdefghijklmnopqrstuvwxyz en minuscule !

Invité · 28/11/2017, 10h27

Bonjour,
Je ne m'explique pas le résultat de ces tests!

Test 1 ########################################################################################################################

TextAtraiter = abcdefghijklmnopqrstuvwxyz

ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z"

ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"

msgbox len(ListPattern) ' ---> 51 caractères
msgbox len(ListSubstit) ' ---> 151 caractères
msgbox UBound(TblPattern) ' ---> 25 indexations
msgbox UBound(TblSubstit) ' ---> 25 indexations

Corriger = [a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-z]

Test 2 ########################################################################################################################

TextAtraiter = ABCDEFGHIJKLMNOPQRSTUVWXYZ

ListPattern = "A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z"

ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"

msgbox len(ListPattern) ' ---> 51 caractères
msgbox len(ListSubstit) ' ---> 155 caractères
msgbox UBound(TblPattern) ' ---> 25 indexations
msgbox UBound(TblSubstit) ' ---> 25 indexations

Corriger = [a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z]

Test 3 ########################################################################################################################

TextAtraiter = ABCDEFGHIJKLMNOPQRSTUVWXYZ

ListPattern = "A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z"

ListSubstit = "[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]"

msgbox len(ListPattern) ' ---> 51 caractères
msgbox len(ListSubstit) ' ---> 155 caractères
msgbox UBound(TblPattern) ' ---> 25 indexations
msgbox UBound(TblSubstit) ' ---> 25 indexations

Corriger = [A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-Z]

**ProgElecT** · 28/11/2017, 19h09

Salut

Tous tes tests sont valides et logiques, leurs résultats sont justes.

Test 1 ########################################################################################################################
TextAtraiter = abcdefghijklmnopqrstuvwxyz
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z"
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
En entrée de boucle For, Corriger = abcdefghijklmnopqrstuvwxyz
-1ér passage, a de Corriger est remplacé par [a-z],
Corriger devient [a-z]bcdefghijklmnopqrstuvwxyz
2ém passage, b de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z]cdefghijklmnopqrstuvwxyz
3ém passage, c de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z][a-z]defghijklmnopqrstuvwxyz
........
24ém passage, y de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z]z
25ém passage, les z de Corriger sont remplacés par [a-z],
Corriger devient [a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-[a-z]][a-z]

Test 2 ########################################################################################################################
TextAtraiter = ABCDEFGHIJKLMNOPQRSTUVWXYZ
ListPattern = "A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z"
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
En entrée de boucle For, Corriger = abcdefghijklmnopqrstuvwxyz
-1ér passage, A de Corriger est remplacé par [a-z],
Corriger devient [a-z]BCDEFGHIJKLMNOPQRSTUVWXYZ
2ém passage, B de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z]CDEFGHIJKLMNOPQRSTUVWXYZ
3ém passage, C de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z][a-z]DEFGHIJKLMNOPQRSTUVWXYZ
........
24ém passage, Y de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z]Z
25ém passage, Z de Corriger est remplacé par [a-z],
Corriger devient [a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z][a-z]

Test 3 ########################################################################################################################
TextAtraiter = ABCDEFGHIJKLMNOPQRSTUVWXYZ
ListPattern = "A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z"
ListSubstit = "[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]|[A-Z]"
En entrée de boucle For, Corriger = ABCDEFGHIJKLMNOPQRSTUVWXYZ
-1ér passage, A de Corriger est remplacé par [A-Z],
Corriger devient [A-Z]BCDEFGHIJKLMNOPQRSTUVWXYZ
2ém passage, B de Corriger est remplacé par [A-Z],
Corriger devient [A-Z][A-Z]CDEFGHIJKLMNOPQRSTUVWXYZ
3ém passage, C de Corriger est remplacé par [A-Z],
Corriger devient [A-Z][A-Z][A-Z]DEFGHIJKLMNOPQRSTUVWXYZ
........
24ém passage, Y de Corriger est remplacé par [A-Z],
Corriger devient [A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z][A-Z]Z
25ém passage, les Z de Corriger sont remplacés par [A-Z],
Corriger devient [A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-[A-Z]][A-Z]

Ouf.... la mise en page a été galère...

Invité · 28/11/2017, 20h28

Bonsoir ProgElecT

Merci pour cette explication!

Je n’avais pas pris conscience que le dernier caractère z était effectivement contenue dans les remplacements Précédents!
Je cherchais vraiment ailleurs.

Donc si je veux que tous mes caractères minuscule, soient remplacés par des [a-z] , il faut trouver un moyen soit d’ignorer le ou les caractères si ils sont de même format "min" et contenus simultanément dans le ListPattern et dans le ListSubstit et les remplacer indépendamment, ou soit….ben je ne sais pas trop en fait!

Les résultats espéré seraient:

TextAtraiter = abcdz
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z"
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
Corriger = [a-z][a-z][a-z][a-z][a-z]

TextAtraiter = abA-3cdz
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z"
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
Corriger = [a-z][a-z]A-3[a-z][a-z][a-z]

TextAtraiter = Zab@c3zh-caz.fr
ListPattern = "a|b|c|d|e|f|g|h|i|j|k|l|m|n|o|p|q|r|s|t|u|v|w|x|y|z"
ListSubstit = "[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]|[a-z]"
Corriger = Z[a-z][a-z]@[a-z]3[a-z][a-z]-[a-z][a-z][a-z].[a-z][a-z]

Ça sent le roussi!

**ProgElecT** · 28/11/2017, 23h13

Je ne comprend pas/plus ou tu veux aller.

Quel retour attends tu pour ces 3 exemples:
abcdz ----------------> ?
abA-3cdz ------------> ?
Zab@c3zh-caz.fr ---> ?

Invité · 28/11/2017, 23h25

Je cherche "simplement" a remplacer toutes les minuscules par [a-z]
aaa = [a-z][a-z][a-z]
aezatm = [a-z][a-z][a-z][a-z][a-z][a-z]
aed56bbAZH-a\f = [a-z][a-z][a-z]56[a-z][a-z]AZH-[a-z]\[a-z]

pour les 3 exemples du poste précédent le retour attendu est donné en Corriger =

**ProgElecT** · 29/11/2017, 08h49

Salut du matin

Je cherche "simplement" a remplacer toutes les minuscules par [a-z]

Donc pour
aaa = [a-z][a-z][a-z]
aezatm = [a-z][a-z][a-z][a-z][a-z][a-z]
aed56bbAZH-a\f = [a-z][a-z][a-z]56[a-z][a-z]AZH-[a-z]\[a-z]
ainsi que ma dernière demande hier
abcdz = [a-z][a-z][a-z][a-z][a-z]
abA-3cdz = abA-3cdz
Zab@c3zh-caz.fr = Z[a-z][a-z]@[a-z]3[a-z][a-z]-[a-z][a-z][a-z].[a-z][a-z]

Il faut, dans la fonction Corriger(TextAtraiter), "simplement" que
ListPattern = "[a-z]|" 'Création de la liste des caractères a rechercher
et
ListSubstit = "[a-z]|" 'Création de la liste des caractères a substituer au Pattern.

Donc la fonction Corriger(TextAtraiter) n'a pas lieux d'être, un simple

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
	Sub TestSub
	Dim strText, RegularExpressioN
 
		strText = MyTextArea.Value
		Set RegularExpressioN = New RegExp
		RegularExpressioN.Pattern = "[a-z]" 'caractère(s) à rechercher
		RegularExpressioN.Global = True
		strText = RegularExpressioN.Replace(strText, "[a-z]")
		Set RegularExpressioN = Nothing
		TextResult.Value = strText
 
	End Sub

Invité · 29/11/2017, 15h48

Salut
Tout simplement!

J'aimerais récupérer le nombre de caractères de mes différents TextBox.

Code :

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

MsgBox Len(strText) & " Occurrence(s) trouvé(s)."

Jusque-là pas de problème
Sauf que pour mon TextBox "MyTextResult" c'est le nombre de [a-z] que j'aimerais compter.

**ProgElecT** · 29/11/2017, 16h52

Salut

Théoriquement c'est une autre question qui devrait être posée dans une nouvelle discussion.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
	'----------------------------------------------------------------------------------------------------------------------
        Function CountOccu(TextAtraiter, OcurenceAtrouver)
        Dim T, U
                T = 0: U = 1
                Do
                        U = InStr(U, TextAtraiter, OcurenceAtrouver, vbTextCompare)
                        If U = 0 Then Exit Do Else T = T + 1: U = U + Len(OcurenceAtrouver)
                Loop
                CountOccu = T
        End Function
 	'----------------------------------------------------------------------------------------------------------------------
  msgbox  CountOccu(" [a-z][a-z][a-z]56[a-z][a-z]AZH-[a-z]\[a-z]","[a-z]") ' ----> 7 occurences

Motif de l’édition:

Encor plus simple (05/11/2012, 17h49) Compter le nombre de caractère sur une chaine de caractères

Code :

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

1
2
3
        Function CountOccu(TextAtraiter, OcurenceAtrouver)
                CountOccu = ubound(Split(TextAtraiter, OcurenceAtrouver))
        End Function

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

VBScript

Discussions similaires

Partager

Partager