HTA recharger script au click sur bouton.

Résolu
NeriXs Messages postés 258 Date d'inscription lundi 4 mai 2015 Statut Membre Dernière intervention 27 février 2024 - 24 déc. 2017 à 11:33
NeriXs Messages postés 258 Date d'inscription lundi 4 mai 2015 Statut Membre Dernière intervention 27 février 2024 - 26 déc. 2017 à 23:34
Bonjour,
J'ai un petit souci avec ce code!
Lorsqu'une modification est faite depuis le TxtSource, celle-ci n'est pas prise en compte lors du click sur mon button.
Pouvez-vous m'indiquer comment recharger le contenue du TxtSource?

<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
APPLICATIONNAME="My HTML application"
ID="MyHTMLapplication"
VERSION="1.0"/>
</head>

<!-- LABEL TxtSource -->
<label for="LabSource">Saisir le texte à traiter:</label></P>

<!-- TEXTBOX TxtSource -->
<TEXTAREA type="text" name="TxtSource" Value ="" style="height:55px; width:500px">-\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/</TEXTAREA></P>

<!-- BUTTON Recherche -->
<input type="button" value="Traitement des caractères minuscules isolés." onClick="Button_Onclick()" style="height:35px; width:500px"></P>

<!-- TEXTBOX TxtList -->
<TEXTAREA type="text" name="TxtList" Value ="" style="height:75px; width:500px"></TEXTAREA></P>

<!-- LABEL LabResult -->
<label style="height:15px; width:500px" for="LabResult">Caractères de la "Phase 1" remplacés:</label></P>

<!-- TEXTBOX TxtResult -->
<TEXTAREA type="text" name="TxtResult" Value ="" style="height:75px; width:500px"></TEXTAREA>

<script language="VBScript">

Option Explicit

Dim StrText, objDico, myarray, arrDicoItem, item
Dim strList, cprovisoire, i, t, bpermute

StrText = TxtSource.value

myarray = Array("\?", "\\", "\,", "\*", "\!", "\-", "\/", "\'")
Set objDico = CreateObject("Scripting.Dictionary")

For Each item In myarray
Recherche(item)
Next

arrDicoItem = objDico.Items

bpermute = True
Do While bpermute = True
bpermute = False
For t = 0 To UBound(arrDicoItem)-1
If CInt(Split(arrDicoItem(t),": ")(1)) > CInt(Split(arrDicoItem(t + 1),": ")(1)) Then
cprovisoire = arrDicoItem(t)
arrDicoItem(t) = arrDicoItem(t + 1)
arrDicoItem(t + 1) = cprovisoire
bpermute = True
End If
Next
Loop

strList = objDico.Count & " correspondance(s) trouvée(s):" & vbcrlf
For i = 0 To UBound(arrDicoItem)
strList = strList & "(" & i+1 & ")" & " " & arrDicoItem(i) & vbCrLf
Next

Dim result
result = StrText
For i=UBound(arrDicoItem) To 0 Step -1
Dim parse1, parse2, intstr
parse1 = "(" & Left(Split(arrDicoItem(i),"trouvée " & """")(1),1) & ")"
parse2 = Split(arrDicoItem(i),"position: ")(1)
intstr = Len(result)
result = Left(result,parse2) & parse1 & Right(result, intstr - parse2 - 1)
Next

Set objDico = Nothing

Sub Button_Onclick()
TxtList.value = strList
TxtResult.value = result
End Sub


Sub Recherche(Caractere)
Dim regex, matches
Dim Pattern, match, i
Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")"

Set regex = New RegExp
regex.Pattern = Pattern
regex.Global = True

Set matches = regex.Execute(StrText)

For Each match In matches
For i = 1 To match.Submatches.Count - 1 Step 2
If Not (match.Submatches(i) = "") Then
objDico.Add match.FirstIndex + Len(match.Value) - 1, _
"Correspondance trouvée """ & _
match.Submatches(i) & """ en position: " & _
match.FirstIndex + Len(match.Value) - 1
End If
Next
Next

Set matches = Nothing
Set regex = Nothing
End Sub

</script>

<body bgcolor="white">

</body>

</html>

2 réponses

cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 27
24 déc. 2017 à 13:29
Bonjour NeriXs,

Ton script ré-adapté puisque texte n'est plus une constante.
<html>
   <head>
      <title>HTA recharger script au click sur bouton</title>
      <HTA:APPLICATION
          APPLICATIONNAME="HTA recharger script au click sur bouton"
          ID="HTArechargerscriptauclicksurbouton"
          VERSION="1.0"/>
   </head>

   <!-- LABEL TxtSource  -->
   <label for="LabSource">Saisir le texte à traiter:</label></P>
		
   <!-- TEXTBOX TxtSource -->
   <TEXTAREA type="text" name="TxtSource" Value ="" style="height:55px; width:500px">-\-\\\*-****/Un test, Pourquoi faire? c'est fou ça! \****-*///*/</TEXTAREA></P>
    	
   <!-- BUTTON Recherche -->
   <input type="button" name="ButtonSearch" value="Traitement des caractères minuscules isolés." style="height:35px; width:500px"></P>

   <!-- TEXTBOX TxtList -->
   <TEXTAREA type="text" name="TxtList" Value="" style="height:75px; width:500px"></TEXTAREA></P>

   <!-- LABEL LabResult -->
   <label style="height:15px; width:500px" for="LabResult">Caractères  de la "Phase 1" remplacés:</label></P>

   <!-- TEXTBOX TxtResult -->
   <TEXTAREA type="text" name="TxtResult" Value ="" style="height:75px; width:500px"></TEXTAREA>

   <script language="VBScript">
   Option Explicit
   Dim objDico
   Set objDico = CreateObject("Scripting.Dictionary")

   Sub ButtonSearch_Onclick()
      Dim myarray, arrDicoItem, item
      Dim strList, strResult, cprovisoire, i, t, bpermute 

      strResult = TxtSource.value
      ' clear textarea
      TxtResult.value = ""
      ' supprime toutes les paires clé-élément existantes dans un objet Dictionary
      objDico.RemoveAll

      myarray = Array("\?", "\\", "\,", "\*", "\!", "\-", "\/", "\'")	

      For Each item In myarray
         Recherche item, strResult
      Next

      arrDicoItem = objDico.Items

      bpermute = True
      Do While bpermute = True               
         bpermute = False
         For t = 0 To UBound(arrDicoItem)-1 
            If CInt(Split(arrDicoItem(t),": ")(1)) > CInt(Split(arrDicoItem(t + 1),": ")(1)) Then 
               cprovisoire = arrDicoItem(t)
               arrDicoItem(t) = arrDicoItem(t + 1) 
               arrDicoItem(t + 1) = cprovisoire 
               bpermute = True
            End If
         Next
      Loop

      strList = objDico.Count & " correspondance(s) trouvée(s):" & vbcrlf
      For i = 0 To UBound(arrDicoItem)
         strList = strList & "(" & i+1 & ")" & " " & arrDicoItem(i) & vbCrLf
      Next
      TxtList.value = strList
   
      For i=UBound(arrDicoItem) To 0 Step -1
         Dim position
          position = Split(arrDicoItem(i),"position: ")(1)
          strResult = Left(strResult,position) & _ 
                      "(" & Left(Split(arrDicoItem(i),"trouvée " & """")(1),1) & ")" & _ 
                      Right(strResult, Len(strResult) - position - 1)
      Next
      TxtResult.value = strResult
   End Sub

   Sub Recherche(Caractere, texte)
      Dim regex, matches
      Dim Pattern, match, i
      Pattern = "([^" & Caractere & "]|^)(" & Caractere & ")(?!" & Caractere & ")"

      Set regex = New RegExp
      regex.Pattern = Pattern
      regex.Global = True

      Set matches = regex.Execute(texte)

      For Each match In matches
         For i = 1 To match.Submatches.Count - 1 Step 2
            If Not (match.Submatches(i) = "") Then
               objDico.Add match.FirstIndex + Len(match.Value) - 1, _
                           "Correspondance trouvée """ & _ 
                           match.Submatches(i) & """ en position: " & _ 
                           match.FirstIndex + Len(match.Value) - 1
            End If    
         Next
      Next
      Set matches = Nothing
      Set regex = Nothing
   End Sub	
   </script>
</html>


jean-marc
2
NeriXs Messages postés 258 Date d'inscription lundi 4 mai 2015 Statut Membre Dernière intervention 27 février 2024 1
26 déc. 2017 à 23:34
Bonjour,
Merci pour la ré-adaptation.
Tout est OK !
0
Rejoignez-nous