Créateur de liste easydcc

Télécharger le projet
Commenter

Description

Pour ceux qui connaissent EasyDcc (http://www.easydcc.fr.st/), logiciel aidant au téléchargement de fichiers sur des xdcc, ListeEasyDCC permet de faire ce que EasyDcc ne faisait pas, c'est à dire avoir la possibilité d'ajouter un fichier manuellement. En effet tous les xdcc n'affichent pas leur liste donc grace à ce logiciel vous pouvez :
- ajouter manuellement un fichier à la liste,
- puis sauvegarder la liste
- et enfin la charger sous easydcc
- vous avez ensuite la possibilité de charger une liste dans ListeEasyDCC

Source / Exemple :

'****************************************
'--- frMain
'****************************************


Private Sub Form_Load()

    strAdr = ""                                                 '--- Adresse Fichier
    StatusBar1.Panels(1).Width = frmMain.Width                  '--- Barre des statuts

End Sub



'---------------------------------------------------
'--- Chargement du fichier txt
'---------------------------------------------------
Private Sub m_Load_Click()

    Dim fso As New FileSystemObject
    Dim Fichier As TextStream
    Dim ListItem As ListItem
    Dim str As String
    Dim ni As Integer
    
On Error GoTo ErrHandler
    
    '--- Ouverture boite de dialogue
    CommonDialog1.Filter = "Fichiers texte (*.txt)|*.txt|Tous les fichiers (*.*)|*.*"
    CommonDialog1.ShowOpen
    
    '--- Définition du fichier
    Set Fichier = fso.OpenTextFile(CommonDialog1.FileName, ForReading, True)
    
    '--- Test Validité
    If Fichier.ReadLine <> "[liste]" Or Fichier.AtEndOfLine = True Then
        MsgBox "Liste non valide", vbCritical, "ERREUR CHARGEMENT LISTE"
        GoTo ErrHandler
    End If
    
    '--- RAZ de la liste
    lwList.ListItems.Clear
    
    '--- Listing
    Do While Fichier.AtEndOfLine <> True
    
        str = Fichier.ReadLine
        Set ListItem = lwList.ListItems.Add(, , TranscripteurTxtList(str, 1))
        For ni = 2 To 6
            ListItem.SubItems(ni - 1) = TranscripteurTxtList(str, ni)
        Next
    Loop
    
    '--- Présentation
    frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
    strAdr = CommonDialog1.FileName
    lblAdresse.Caption = CommonDialog1.FileName
    lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
    txtIRC.Text = ""
    txtTaille.Text = ""
    txtNom.Text = ""
    txtChan.Text = ""
    txtServ.Text = ""
    Action "Liste """ & CommonDialog1.FileName & """ chargée"
    
    '--- Destruction des objets
    Fichier.Close
    Set fso = Nothing
    Set Fichier = Nothing
    
    Exit Sub

ErrHandler:

    '--- L'utilisateur a sélectionné le bouton Annuler.
    Action "Chargement annulé"
    
    '--- Destruction des objets
    Set fso = Nothing
    Set Fichier = Nothing
    
    Exit Sub

End Sub



'---------------------------------------------------
'--- Sauvegarde de la liste
'---------------------------------------------------
Private Sub m_Save_Click()


    Dim fso As New FileSystemObject
    Dim Fichier As TextStream
    Dim strTxt As String
    Dim ni As Integer
    Dim nEl As Integer
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    
On Error GoTo Erreur ' Prise en charge des erreurs
    
    ' Verifie si le fichier existe déjà
    If (fso.FileExists(strAdr)) Then
    
        ' Si oui, enregistre les nouvelles
        ' données dans le fichier texte existant
        Set Fichier = fso.OpenTextFile(strAdr, ForWriting, False)
        
        '--- Pour que le fichier soit reconnu
        Fichier.WriteLine "[liste]"
        
        nEl = lwList.ListItems.Count
        For ni = 1 To nEl
            '--- Préparation ligne list -> txt
            
            '--- Nick
            strTxt = ""
            strTxt = lwList.ListItems(ni).Text
            strTxt = Replace(strTxt, "[", "~")
            strTxt = Replace(strTxt, "]", "")
            
            '--- N°
            strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
            
            '--- Taille - 1
            strPart = ""
            strPart = lwList.ListItems(ni).SubItems(2)
            nDeb = 1
            nFin = InStr(1, strPart, "K")
            If nFin = 0 Then
                nFin = InStr(1, strPart, "M")
            End If
            nLong = nFin - nDeb
            strPart = Mid(strPart, nDeb, nLong)
            strTxt = strTxt & strPart & ";"
            
            '--- Taille - 2
            strPart = ""
            strPart = lwList.ListItems(ni).SubItems(2)
            nFin = InStr(1, strPart, "K")
            If nFin = 0 Then
                strTxt = strTxt & "MB" & ";"
            Else
                strTxt = strTxt & "KB" & ";"
            End If
            
            '--- Nom
            strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
            
            '--- Channel
            strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
            
            '--- Serveur
            strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"

            '--- écriture dans le fichier
            Fichier.WriteLine strTxt
        Next
    
    ' Si le fichier texte n'existe pas, le créer
    Else
        ' Ouverture du CommonDialog pour enregistrer le fichier
        CommonDialog1.Filter = "Fichier Texte (*.txt)|*.txt;|"
        CommonDialog1.ShowSave
        
        If CommonDialog1.FileName <> "" Then
            With fso
                ' Crée le nouveau fichier
                strAdr = .BuildPath(.GetParentFolderName(CommonDialog1.FileName), _
                CommonDialog1.FileTitle)
                Set Fichier = .CreateTextFile(strAdr, True)
            End With
            
            '--- Pour que le fichier soit reconnu
            Fichier.WriteLine "[liste]"
            
            nEl = lwList.ListItems.Count
            For ni = 1 To nEl
                '--- Préparation ligne list -> txt
                
                '--- Nick
                strTxt = ""
                strTxt = lwList.ListItems(ni).Text
                strTxt = Replace(strTxt, "[", "~")
                strTxt = Replace(strTxt, "]", "")
                
                '--- N°
                strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
                
                '--- Taille - 1
                strPart = ""
                strPart = lwList.ListItems(ni).SubItems(2)
                nDeb = 1
                nFin = InStr(1, strPart, "K")
                If nFin = 0 Then
                    nFin = InStr(1, strPart, "M")
                End If
                nLong = nFin - nDeb
                strPart = Mid(strPart, nDeb, nLong)
                strTxt = strTxt & strPart & ";"
                
                '--- Taille - 2
                strPart = ""
                strPart = lwList.ListItems(ni).SubItems(2)
                nFin = InStr(1, strPart, "K")
                If nFin = 0 Then
                    strTxt = strTxt & "MB" & ";"
                Else
                    strTxt = strTxt & "KB" & ";"
                End If
                
                '--- Nom
                strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
                
                '--- Channel
                strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
                
                '--- Serveur
                strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"
    
                '--- écriture dans le fichier
                Fichier.WriteLine strTxt
            Next
            
            ' Modifie le Caption de la fenetre, par le nom du fichier
            frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
            strAdr = CommonDialog1.FileName
            lblAdresse.Caption = CommonDialog1.FileName
            lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
            Action "Liste """ & CommonDialog1.FileName & """ chargée"
            
        End If
    End If
    Action strAdr & " a bien été enregistrer"
    
    Exit Sub ' Aucune erreur, donc sortie
    
Erreur:
    '--- L'utilisateur a sélectionné le bouton Annuler.
    Action "Sauvegarde annulée"
    
End Sub



'---------------------------------------------------
'--- Crédits
'---------------------------------------------------
Private Sub m_Cred_Click()

    Action "Logiciel réalisé par Ranouf, ranouf@hotmail.com"

End Sub



'---------------------------------------------------
'--- Nouvelle Liste
'---------------------------------------------------
Private Sub m_New_Click()
    
    '--- RAZ Fichier
    strAdr = ""
    lblAdresse.Caption = "[Aucun]"
    lblTaille.Caption = "[Aucun]"
    txtIRC.Text = ""
    frmMain.Caption = "Gestion Liste EasyDCC - Nouvelle Liste"
    
    '--- RAZ de la liste
    lwList.ListItems.Clear
    
    
End Sub



'---------------------------------------------------
'--- Click sur la liste
'---------------------------------------------------
Private Sub lwList_Click()
    
    If lwList.ListItems.Count <> 0 Then
        Cmd_Mode (1)
        nIndexSelectionne = lwList.SelectedItem.Index
        txtIRC.Text = TranscripteurListIRC(lwList.ListItems(nIndexSelectionne))
        txtTaille.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(2)
        txtNom.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(3)
        txtChan.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(4)
        txtServ.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(5)
    End If

End Sub



Private Sub lwList_ItemClick(ByVal Item As MSComctlLib.ListItem)

    lwList_Click
    
End Sub



'---------------------------------------------------
'--- Changement texte IRC
'---------------------------------------------------
Private Sub txtIRC_KeyUp(KeyCode As Integer, Shift As Integer)
    If nIndexSelectionne <> 0 Then
        If TranscripteurListIRC(lwList.ListItems(nIndexSelectionne)) = txtIRC.Text Then
            Cmd_Mode (1)
        Else
            Cmd_Mode (0)
        End If
    End If
End Sub



'---------------------------------------------------
'--- Actions Bouton cmd
'---------------------------------------------------
Private Sub cmd_Click(Index As Integer)

    Dim ni As Integer
    Dim ListItem As ListItem
    Dim bErr As Boolean
    
    Select Case (Index)
        
        '--- Bouton Ajouter
        Case 0:
            bErr = False
            If txtIRC.Text = "" Then
                lblErr.Visible = True
                lblInfoIrc.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoIrc.ForeColor = &H80000012
            End If
            
            If txtTaille.Text = "" Then
                lblErr.Visible = True
                lblInfoTaille.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoTaille.ForeColor = &H80000012
            End If
            
            If txtNom.Text = "" Then
                lblErr.Visible = True
                lblInfoNom.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoNom.ForeColor = &H80000012
            End If
            
            If txtChan.Text = "" Or InStr(1, txtChan.Text, "#") = 0 Then
                lblErr.Visible = True
                lblInfoChan.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoChan.ForeColor = &H80000012
            End If
            
            If txtServ.Text = "" Then
                lblErr.Visible = True
                lblInfoServ.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoServ.ForeColor = &H80000012
            End If
            
            If bErr = True Then
                Exit Sub
            End If
            
            Action txtIRC.Text & " a bien été ajouté"
            
            '--- Ajout dans la liste
            Set ListItem = lwList.ListItems.Add(, , TranscripteurIRCList(txtIRC.Text, 1))
            ListItem.SubItems(1) = TranscripteurIRCList(txtIRC.Text, 2)
            ListItem.SubItems(2) = txtTaille.Text
            ListItem.SubItems(3) = txtNom.Text
            ListItem.SubItems(4) = txtChan.Text
            ListItem.SubItems(5) = txtServ.Text
            'nOcc = InStr(nOcc + 1, str, ";")
            'TranscripteurIRCList( txtirc.Text, txttaille.Text, txtnom.Text, txtchan.Text, txtserv.Text)
            
            
            
        
        '--- Bouton Supprimer
        Case 1:
        
            Action txtIRC.Text & " a bien été supprimé"
            
            '--- RAZ informations
            txtIRC.Text = ""
            txtTaille.Text = ""
            txtNom.Text = ""
            txtChan.Text = ""
            txtServ.Text = ""
            Cmd_Mode (0)
            
            '--- suppression de l'élément
            lwList.ListItems.Remove lwList.SelectedItem.Index
            
            nIndexSelectionne = 0
         
        '--- Bouton Nouveau
        Case 2:
            
            Action "Nouveau téléchargement"
            
            '--- RAZ informations
            txtIRC.Text = "/ctcp [NomXDCC] xdcc send #[N°]"
            txtTaille.Text = ""
            txtNom.Text = ""
            txtChan.Text = "#"
            txtServ.Text = ""
            Cmd_Mode (0)
            
            nIndexSelectionne = 0
            
    End Select


End Sub











'***************************************************
'*** module************ *****************************
'***************************************************




Option Explicit
Public strAdr As String                     '--- Adresse fichier en cours
Public nCmd_Mode As Integer                 '--- Mode Ajout et Supprimer
Public nIndexSelectionne As Integer         '--- Index de l'élément sélectionné dans la liste


'***************************************************
'*** APPLICATIONS DIVERSES *************************
'***************************************************

'---------------------------------------------------
'--- Affiche dans la barre de statut str ----------
'---------------------------------------------------
Public Sub Action(str As String)

    frmMain.StatusBar1.Panels(1).Text = str
    
End Sub



'---------------------------------------------------
'--- Passe cmd en mode Ajout ou Supprimer  ----------
'---------------------------------------------------
Public Sub Cmd_Mode(nb As Integer)
    
    
    If nb = 1 Then
        '--- Supp
        frmMain.cmd(1).Enabled = True
        frmMain.cmd(0).Enabled = False
    Else
        '--- Ajout
        frmMain.cmd(0).Enabled = True
        frmMain.cmd(1).Enabled = False
    End If
    frmMain.lblInfoIrc.ForeColor = &H80000012
    frmMain.lblInfoTaille.ForeColor = &H80000012
    frmMain.lblInfoNom.ForeColor = &H80000012
    frmMain.lblInfoChan.ForeColor = &H80000012
    frmMain.lblInfoServ.ForeColor = &H80000012
    frmMain.lblErr.Visible = False
    nCmd_Mode = nb
    
End Sub



'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurTxtList(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 1 à #
            nDeb = 0
            nFin = InStr(1, str, "#")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            strPart = Mid(str, nDeb + 1, nLong - 1)
            strPart = Replace(strPart, "~", "[")
            strPart = Replace(strPart, "", "]")

        Case 2:
            '--- Partie recherché # à =
            nDeb = InStr(1, str, "#")
            nFin = InStr(1, str, "=")
            nLong = nFin - nDeb
            strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
            
        Case 3:
            '--- Partie recherché = à ; et de ; à ;
            nDeb = InStr(1, str, "=")
            nFin = InStr(1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
            nDeb = InStr(1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
            
        Case 4:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 5:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 6:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            '--- 3e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
    End Select
    
    TranscripteurTxtList = strPart

End Function



'---------------------------------------------------
'--- Transcrire IRC => List ------------------------
'---------------------------------------------------
'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurIRCList(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 7 à xdcc send
            nDeb = 6
            nFin = InStr(1, str, "xdcc send")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 2)

        Case 2:
            '--- Partie recherché xdcc send à end
            nDeb = InStr(7, str, "#")
            strPart = "#" & Mid(str, nDeb + 1)
            
    End Select
    
    TranscripteurIRCList = strPart

End Function

'---------------------------------------------------
'--- Transcrire List => IRC ------------------------
'---------------------------------------------------
'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurListIRC(ListItem As ListItem) As String
    
    'sur l'exemple de easydcc : /ctcp Xdcc`Midori xdcc send #20
    TranscripteurListIRC = "/ctcp " & ListItem.Text & " xdcc send " & ListItem.SubItems(1)

End Function



'---------------------------------------------------
'--- Transcrire List => Txt ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurListTxt(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 1 à #
            strPart = Replace(strPart, "~", "[")
            strPart = Replace(strPart, "", "]")

        Case 2:
            '--- Partie recherché # à =
            nDeb = InStr(1, str, "#")
            nFin = InStr(1, str, "=")
            nLong = nFin - nDeb
            strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
            
        Case 3:
            '--- Partie recherché = à ; et de ; à ;
            nDeb = InStr(1, str, "=")
            nFin = InStr(1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
            nDeb = InStr(1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
            
        Case 4:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 5:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 6:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            '--- 3e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
    End Select
    
    TranscripteurListTxt = strPart

End Function

Conclusion :

J'espere que ça vous plaira !!
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ranouf)