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

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

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:

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:

strLine = Replace_Char(strLine)

Pourriez-vous m'aider?

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

Code:

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)

22/11/2017, 18h30
Invité

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

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

Code:

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>

Salut

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

Code:

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>

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:

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?

Ok, donc

Code:

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).

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:

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)

Il doit y avoir une erreur ailleurs car

Code:

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

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:

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>

27/11/2017, 22h50
Invité

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 !
28/11/2017, 10h27
Invité

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]
28/11/2017, 19h09
ProgElecT

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]

:whistle2: Ouf.... la mise en page a été galère...:arf:
28/11/2017, 20h28
Invité

Bonsoir ProgElecT

Merci pour cette explication! :king:

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! :scarymov:
28/11/2017, 23h13
ProgElecT

:koi: Je ne comprend pas/plus ou tu veux aller.

Quel retour attends tu pour ces 3 exemples:
abcdz ----------------> ?
abA-3cdz ------------> ?
Zab@c3zh-caz.fr ---> ?
28/11/2017, 23h25
Invité

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 =

Salut du matin ;)

Citation:

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:

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

29/11/2017, 15h48
Invité

Salut
Tout simplement! :merci:
J'aimerais récupérer le nombre de caractères de mes différents TextBox.

Code:

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.

Salut

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

Code:

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:
:aie: Encor plus simple (05/11/2012, 17h49) Compter le nombre de caractère sur une chaine de caractères

Code:

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

Voir 40 message(s) de cette discussion en une page