Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre actif
    Homme Profil pro
    retraité
    Inscrit en
    juillet 2011
    Messages
    349
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 73
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : juillet 2011
    Messages : 349
    Points : 236
    Points
    236

    Par défaut Creer une balise avec un lien hypertext variable

    Bonjour
    Je souhaiterai avoir un moyen d' accéder directement sur un lien qui aurait l' adresse de destination (HTTP....).
    Actuellement je passe par une procédure "exécuter", mais cela ne plait guère.
    Je pense qu' on doit pouvoir faire l' équivalent que j' utilise dans un VBA en passant par un objet Label d' un Userform.
    Merci pour votre aide.
    Windows 8.1
    Firefox Quantum 58.0.1 (64 bits)
    Google Chrome Version 67.0.3396.99 (Build officiel) (64 bits)

  2. #2
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    juin 2009
    Messages
    3 573
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : juin 2009
    Messages : 3 573
    Points : 8 590
    Points
    8 590

    Par défaut

    SVP, postez votre code pour comprendre mieux votre requête !

    Edit :
    Voici un petit exemple en HTA :
    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
    <html>
    <head>
    <HTA:APPLICATION
    APPLICATIONNAME="Open links with IE, Chrome and Firefox and how to pass command line"
    BORDER="THIN"
    BORDERSTYLE="NORMAL"
    ICON="nslookup.exe"
    INNERBORDER="NO"
    MAXIMIZEBUTTON="NO"
    MINIMIZEBUTTON="NO"
    SCROLL="NO"
    SELECTION="NO"
    SINGLEINSTANCE="YES"/>
    <title>Open links with IE, Chrome and Firefox and how to pass command line</title>
    <SCRIPT LANGUAGE="VBScript">
     
    '************************************************************************************
    Sub window_onload()
        CenterWindow 480,250
    End Sub
    '************************************************************************************
    Sub CenterWindow(x,y)
        Dim iLeft,itop
        window.resizeTo x,y
        iLeft = window.screen.availWidth/2 - x/2
        itop = window.screen.availHeight/2 - y/2
        window.moveTo ileft,itop
    End Sub
    '************************************************************************************
     Function Executer(StrCmd,Console)
        Dim ws,MyCmd,Resultat
        Set ws = CreateObject("wscript.Shell")
    'La valeur 0 pour cacher la console MS-DOS
        If Console = 0 Then
            MyCmd = "CMD /C " & StrCmd & " "
            Resultat = ws.run(MyCmd,Console,True)
            If Resultat = 0 Then
                'MsgBox "Success"
            Else
                MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
            End If
        End If
    'La valeur 1 pour montrer la console MS-DOS
        If Console = 1 Then
            MyCmd = "CMD /K " & StrCmd & " "
            Resultat = ws.run(MyCmd,Console,False)
            If Resultat = 0 Then
                'MsgBox "Success"
            Else
                MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
            End If
        End If
        Executer = Resultat
    End Function
    '************************************************************************************
      
    </script>
    </head>
    <BODY text=white bgcolor="DarkOrange" TOPMARGIN="1" LEFTMARGIN="1">
    <p>Links List (examples) :</p>
    <ol>
    <li><a href="#" onClick="Call Executer('Start iexplore.exe www.google.com',0)">Lien Google avec iexplore.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start chrome.exe http://com/',0)">Lien BBAT avec Chrome.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start Firefox.exe www.developpez.net',0)">Lien developpez.net avec Firefox.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start chrome.exe www.yahoo.fr',0)">Lien Yahoo avec Chrome.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.fr',0)">Lien Autoitscript.fr (Français) avec Chrome.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.com',0)">Lien autoitscript.com (Anglais) avec Chrome.exe</a></li>
    <li><a href="#" onClick="Call Executer('Start www.sfr.fr',0)">Lien SFR avec votre navigateur by default</a></li>
    </ol>
    </body>
    </html>

  3. #3
    Membre actif
    Homme Profil pro
    retraité
    Inscrit en
    juillet 2011
    Messages
    349
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 73
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : juillet 2011
    Messages : 349
    Points : 236
    Points
    236

    Par défaut

    voici le code (lignes 319 a 321)

    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
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    <html><head>
    <title>le films choisi</title>
    <HTA:APPLICATION
                    APPLICATION='gestion des vidéos'
                    ID="ChildApplication"
                    SCROLL='no'>
     </head>
     <SCRIPT LANGUAGE="VBScript">
     ' option explicit
    '    Const path = "HKCU\Volatile Environment\MsgResp"
            dim ofso  ,objShell ,z , phot ,no_image, adr
            dim nom, typ, aff, mo, an , desc, duree, adresse
            dim maxa          ' Nb acteurs
            dim raff, ract ,rep_parent, dac
            dim curdir           
            dim googledrive   
          const films       =        "Films.txt"
          const acteurs     =      "Acteurs.txt"
          const filmact     =      "filmact.txt"
          const synopsis    =     "SYNOPSIS.txt"
          const origines    =     "origines.txt"
          const genres      =       "genres.txt"
          const realisateurs= "Réalisateurs.txt"
              Const ForReading  = 1
              Const TristateTrue= -1     ' Unicode
          Set  objShell= CreateObject("Wscript.Shell")
          Set     ofso = CreateObject("Scripting.FileSystemObject")
          Set   dac    = CreateObject("Scripting.Dictionary")
          Google_Drive = _
          objShell.ExpandEnvironmentStrings("%USERPROFILE%") & _
                                    "\Google Drive"
            curdir     = objShell.CurrentDirectory
            rep_parent = ofso.getparentfoldername(curdir)
                         raff  = rep_parent  & "\Affiches de films\"
                         ract  = rep_parent  & "\Acteurs\"
     
    While Not  ofso.FolderExists(ract) 'then exit do
         ract = Google_Drive & "\Acteurs\"
         if not ofso.FolderExists(ract) then msgbox ract,,"?" : wincow close
         raff = Google_Drive & "\Affiches de films\"
         if not ofso.FolderExists(raff) then msgbox raff,,"?" : wincow close
    Wend     
            dim maxl,maxh,top2
            maxl =1120    : maxh = 860
            window.resizeTo maxl -150,window.screen.availHeight
            window.moveTo   0 ,0
    '_______________________________________________________________________________
     
    sub window_onload
            Dim   arguments 
              arguments = Split(ChildApplication.CommandLine,"!")
    If ubound(arguments)=0 Then  Exit Sub
    '               depuis le Film.hta
    'alert arguments(1)
         nf   =  Replace(arguments(1),Chr(34),"") 
         affichage  nf  
    end sub
    '_______________________________________________________________________________
     
    sub fin_OnClick
            window.close()
    End sub
    sub window_onunload
            Set objShell  = nothing
            Set oFSO      = nothing
            window.close()
    end sub
     
    '_______________________________________________________________________________
     
    sub charge_acteurs(nf)  
            Dim lig, nfx, na, f
        Dim txa(2000)       ' presences acteur
        maxa=0               
                            Set f = open(filmact)
     do while Not     f.AtEndOfStream
         lig  =     f.readline
         nfx  = split(lig,";")(0)
         na   = split(lig,";")(1)+0
         If nf=nfx Then
                 maxa = maxa+1
                 txa(na)=True       ' presence      acteurs du film
             Else
                 txa(na)=False
                    If maxa>0 Then  :Exit do
             End If
      Loop
         f.Close    
    'end sub
    'sub charge_dac
    '        - Num acteur
     '       - nom acteur
      '      - photo (jpg)
       '     - web   (adresse internet)
        '    - present dans au moins 1 film (vrai/faux)
     
      Dim num 
              i=0
                            Set f    = open(acteurs)
      Do While Not     f.AtEndOfStream
            lig  =  f.readline
         if lig<>""  then
            num  = split(lig,";")(0)  +0
            If txa(num) Then
                    i=i+1
                    dac.Add lig,""
            End If
            if i = maxa  then   :Exit do 
         end if
      Loop     
       f.Close  
    end sub
    '_______________________________________________________________________________
     
    sub affichage(nf)
        Dim rs,lig ,i ,l  ,n,v,f,nr,ng,no, zr
     
                            lig = lili(nf,films,    ";")     
            rs                       = split(lig,";")
     
              nof.value  = rs(0)     
         document.title  = rs(1)
             typf.value  = rs(2)
             affi.value  = rs(3) 
             nbmo.value  = rs(4)
             durf.value  = rs(5)
               hm.value  = dur(rs(5))
                      ng = rs(6)+0
                      no = rs(7)+0
             anne.value  = rs(8)
                            adr  = rs(9)
                     zr  = rs(11)
           If zr="" Then nr=9 Else nr=zr +0
                            lig = lili(no,origines,    ";")  
      origine.value = Split(lig,    ";")(1)  
                            lig = lili(ng,genres,      ";")
            genre.value = Split(lig,    ";")(1)
                        lig = lili(nr,realisateurs,";")
          rea.value = Split(lig,    ";")(1)
                        lig = lili(nf,synopsis,    "|")               
         resu.value = Split(lig,    "|")(1)  
    '        id("SaveRes").innerhtml = adr
     
    web.value=adr
            Call  affiche (affi.value)
                    Call  charge_acteurs(nf)         
              nba.value = maxa & " acteurs"
     
                    Call prep_photos              
    End sub
    '_______________________________________________________________________________
     
    Function open(f)
             set open = oFso.OpenTextFile(f,ForReading, TristateTrue)
    End function 
    '_______________________________________________________________________________
     
    Function lili(n,fic,sep)
                              Dim t,num,f 
                                Set f = open(fic)
              While Not         f.AtEndOfStream
                       lili =               f.readline
                     t  = split(lili,sep)
                    num = t(0)  +0  
                 If num = n+0 Then
                    f.Close :               Exit function 
             End If   
              Wend   
    End function 
    '_______________________________________________________________________________
     
    function xx(v)
             xx = chr(34) & trim(v) & chr(34)
    end function
    '_______________________________________________________________________________
     
    sub affiche(jpg)
            dim zaff, shp
                zaff = raff &  jpg
           if not ofso.FileExists(zaff) then
                     imaf.src="Affiche non trouvée.bmp"
           else
             shp         = oFSO.GetFile(zaff).shortpath
             imaf.src    = shp
           end if
    end sub
    '_______________________________________________________________________________
     
    function dur (mn)
            dim h,m
            if mn<>"" then
                   h    = int(mn/60)
                   m    = mn mod 60
                    dur = h & "h" & right(m+100,2)
            end if
    end function
    '_______________________________________________________________________________
     
    function nom_propre(z)
            dim np,x,mot,i,s
             x= split(lcase(z)," ")
             for i=0 to ubound(x)
                  mot=x(i) : np=np & s & ucase(left(mot,1)) :  s=" "
                   if len(mot)>1 then np=np  & mid(mot,2)
             next
             nom_propre = np
    end function
    '_______________________________________________________________________________
     
    Function id(o)
            Set id = document.getElementById(o)
    End Function
    '_______________________________________________________________________________
     
    Function nom_propre(v)
             nom_propre =   Ucase(Left(v,1)) & Mid(v,2)
    End Function
    '_______________________________________________________________________________
     
    sub prep_photos
            if dac.Count =0 Then Exit Sub
            dim z,i, z1,z2,z3 ,top, Left, jpg, npho, zon,taw
            const larg=90
            const nbc =9     ' nb colonnes
              nph =maxa      ' nb photos
            const top1=440     : top=top1
            taw = dac.Keys 
            for i=1 to nph
                               zon = taw(i-1)       ': alert zon
                            If zon<>"" then
                          jpg  = xx( ract    &  Split(zon,";")(2) )
                          npho = xx( nom_propre(Split(zon,";")(1)))
                if i=nbc+1 then top=top+145
                if i=1 or i=nbc+1 then left=20 else left=left+larg+10
             z1="<div style='position: absolute;  left: " & _
                left & "px; top: " & top & "px ;'>"  & vbcr
     
             z2="<img  src=" & jpg   &  _
             " style='border:none; width:" &   larg & "px;'" & _
             "  OnClick='aff_acteur " & i & "'><br>"  & vbcr
     
             z3="<input type='text' "  & _
             " style='background-color :transparent; border:none;" & _
             " text-align:center; width:" & _
                       larg & "px;    font-size:11px; '" & _
             " value=" & npho  & "></div>"   & vbcr
             z=z & z1 & z2 & z3   & vbCr
             End If
            next                 ' : alert z
            id("SaveRes").innerhtml = z
    end sub
    '_______________________________________________________________________________
     
    sub aff_acteur(i)
            Dim num ,pgm,cmdline
    '        If i>nactf.length then exit sub
     '       num = nactf(i-1).value
    Const   hta = "maj Acteurs.hta"
            pgm = oFSO.GetFile(hta).shortpath
            cmdline = "mshta.exe " &  xx(pgm)   & " !" & xx(num)  
                objShell.Run cmdline,0,True
    End sub
    '_______________________________________________________________________________
     
    sub Executer()
            Dim MyCmd 
                    MyCmd = "CMD /C Start " &  replace(adr,"#","")  ': alert mycmd
                objShell.run MyCmd,0,False
    End sub
     
     
    Function id(o)
            Set id = document.getElementById(o)
    End Function
      </script>
     <body>
     
    <div  style='position: absolute; left: 715px; top: 10px;'>
    <img name='imaf' style='width:230px;text-align: center;' >
    <br><br>
    <input type='text'   name='nba'
                                     style='text-align: center;
                    background-color :transparent; border:none; '>
    </div> 
     
     
    <div  style='position: absolute; left: 6px; top: 0px;
                    border:none;'>
    <table cellspacing='2px' cellpadding='2px;' rules='all'
                 style='border:solid 1px black;'>
       <caption>Caractéristiques du film N°
       <input type='text'  ID='nof'    
         style='background-color :transparent; border:none;text-align:left;'>
       </caption>
    <tr><td>Type   <td><input type='text'   name='typf'
                     style='border:none;'
             size='3'         maxsize='3'>
    <tr><td>Affiche<td><input type='text'   name='affi'
                     style='border:none;'
             size='80'        maxsize='100'>
    <tr><td>Genre  <td><input type='text'   name='genre' 
                     style='border:none;'>
    <tr><td>origine<td><input type='text'   name='origine'
                     style='border:none;'>
    <tr><td>Taille <td><input type='text'   name='nbmo'  size='4'
                     style='border:none;'     >(Mo)
    <tr><td>Durée  <td>   <input type='text'  
                    name='durf'  size='3'
                                     style='border:none;'       >(mn)
             <input type='text'  name='hm'  disabled size='8'
            style='background-color :transparent; border:none; text-align:center;'>
    <tr><td>Année <td>    <input type='text'  name='anne'  size='4' 
                     style='border:none;'       >
    <tr><td>Réalisateur<td><input type='text'   name='rea' 
             style='border:none;'>
     
    <tr><td>Web 
            <td><input type='text'   name='web' size='60'
            style='border:none;' readonly>  
            <td><a href='#' onClick='Executer'>Lien vers le web   </a>
    </table>
     
    <TEXTAREA   NAME="SYNOPSIS" ID='resu'
           ROWS='8' style='width: 710px;'        >
           </TEXTAREA> <br><br>
           </div>
     
    <div    style='position: absolute; left:650px; top: 0px;'>
    <input type="button" value='Quitter'  style='cursor:pointer'  ID='fin'>
    </div>
     
    <span id='SaveRes'></span>
    </body>
    Windows 8.1
    Firefox Quantum 58.0.1 (64 bits)
    Google Chrome Version 67.0.3396.99 (Build officiel) (64 bits)

  4. #4
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    juin 2009
    Messages
    3 573
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : juin 2009
    Messages : 3 573
    Points : 8 590
    Points
    8 590

    Par défaut VOD_KIDS.hta


    Voici un code complet en pièce-jointe qui peut télécharger une liste de type m3u et lire son contenu de façon dynamique afin de regarder quelques films pour enfants
    Remarque : Il faut qu'au préalable avoir la version 32 bits de l'application VLC même si l'architecture de votre système de windows installé est de type 64 bits !!!
    Images attachées Images attachées   
    Fichiers attachés Fichiers attachés

  5. #5
    Membre actif
    Homme Profil pro
    retraité
    Inscrit en
    juillet 2011
    Messages
    349
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 73
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : juillet 2011
    Messages : 349
    Points : 236
    Points
    236

    Par défaut

    Merci, mais cela ne correspond pas a ce que je veux faire.
    Windows 8.1
    Firefox Quantum 58.0.1 (64 bits)
    Google Chrome Version 67.0.3396.99 (Build officiel) (64 bits)

Discussions similaires

  1. Réponses: 0
    Dernier message: 21/05/2012, 12h32
  2. Creer un userform dynamique avec curseur Lien hypertexte
    Par fred65200 dans le forum Contribuez
    Réponses: 1
    Dernier message: 17/05/2009, 12h01
  3. [HTML] Mettre une balise <object> en lien hypertext
    Par muaddibx dans le forum Balisage (X)HTML et validation W3C
    Réponses: 9
    Dernier message: 10/07/2008, 15h19
  4. problème lors de la selection d'une cellule avec un lien hypertexte
    Par jamelie dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 19/12/2007, 11h16
  5. [XSLT] - Comment selectionner une balise avec un nom variable ?
    Par bchabot dans le forum XSL/XSLT/XPATH
    Réponses: 2
    Dernier message: 25/04/2006, 10h59

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo