Public Function DeleteLine(byref oTableau As String(), byval lIndexLigne as long) As String() dim i as long dim oResultat() as String dim lIndexCopie as long redim oResultat(UBound(oTableau)) for i = 0 to UBound(oTableau) if i <> lIndexLigne then let lIndexCopie = lIndexCopie + 1 let oResultat(lIndexCopie) = oTableau(i) end if next i Let DeleteLine = oResultat End Sub
Dim i as long Dim tonTexte As String Dim tableauDeString() As String ' récupération du tableau tonTexte = "un texte" & vbcrlf & "qui tient" & vbcrlf & "sur plusieurs lignes." tableauDeString = Split(tonTexte, vbcrlf) 'traitement pour supprimer les lignes tableauDeString = DeleteLine(tableauDeString, 1) 'reconversion en string : for i = 0 to ubound(tableauDeString) if i > 0 then tonTexte = tonTexte & vbcrlf tonTexte = tonTexte & tableauDeString(i) next i End if
Public Function DeleteLine(ByRef oTableau() As String, ByVal lIndexLigne As Long) As String() Dim i As Long Dim oResultat() As String Dim lIndexCopie As Long ReDim oResultat(UBound(oTableau) - 1) For i = 0 To UBound(oTableau) If i <> lIndexLigne Then Let oResultat(lIndexCopie) = oTableau(i) Let lIndexCopie = lIndexCopie + 1 End If Next i Let DeleteLine = oResultat End Function Private Sub Form_Load() Dim i As Long Dim tonTexte As String Dim tableauDeString() As String ' récupération du tableau tonTexte = "un texte" & vbCrLf & "qui tient" & vbCrLf & "sur plusieurs lignes." tableauDeString = Split(tonTexte, vbCrLf) 'traitement pour supprimer les lignes tableauDeString = DeleteLine(tableauDeString, 1) 'reconversion en string : tonTexte = "" For i = 0 To UBound(tableauDeString) If i > 0 Then tonTexte = tonTexte & vbCrLf End If tonTexte = tonTexte & tableauDeString(i) Next i End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionDim i as long Dim tonTexte As String Dim tableauDeString() As String ' récupération du tableau tonTexte = "un texte" & vbcrlf & "qui tient" & vbcrlf & "sur plusieurs lignes." tableauDeString = Split(tonTexte, vbcrlf) 'traitement pour supprimer les lignes '... 'reconversion en string : for i = 0 to ubound(tableauDeString) if i > 0 then tonTexte = tonTexte & vbcrlf tonTexte = tonTexte & tableauDeString(i) next i
rows(numero_de_la_ligne).Deletemais il me marque que "Erreur de compilation : Sub ou Function non définie en surlignant Rows Je ne comprends pas pourquoi cela ne veut pas fonctionner alors que dans les programmes que j'ai trouvé cela fonctionne...
Dim i as long Dim tonTexte As String Dim tableauDeString() As String ' récupération du tableau tonTexte = "un texte" & vbcrlf & "qui tient" & vbcrlf & "sur plusieurs lignes." tableauDeString = Split(tonTexte, vbcrlf) 'traitement pour supprimer les lignes tableauDeString(6).Delete 'reconversion en string : for i = 0 to ubound(tableauDeString) if i > 0 then tonTexte = tonTexte & vbcrlf tonTexte = tonTexte & tableauDeString(i) next i End if
Public Function DeleteLine(byref oTableau() As String, byval lIndexLigne as long) As String() dim i as long dim oResultat() as String dim lIndexCopie as long redim oResultat(UBound(oTableau)) for i = 0 to UBound(oTableau) if i <> lIndexLigne then let lIndexCopie = lIndexCopie + 1 let oResultat(lIndexCopie) = oTableau(i) end if next i Let DeleteLine = oResultat End Sub
' Traitement pour supprimer les lignes tableauDeString = DeleteLine(tableauDeString, 1)
Option Explicit ' Copier dans un tableau les lignes qui doivent rester Public Function DeleteLine(ByRef oTableau() As String, ByVal lIndexLigne As Long) As String() Dim i As Long Dim oResultat() As String Dim lIndexCopie As Long ReDim oResultat(UBound(oTableau) - 1) For i = 0 To UBound(oTableau) If i <> lIndexLigne Then Let oResultat(lIndexCopie) = oTableau(i) Let lIndexCopie = lIndexCopie + 1 End If Next i Let DeleteLine = oResultat End Function Private Sub Application_ItemSend(ByVal Item As Object, _ Cancel As Boolean) Dim Courriel As MailItem Dim Destinataires As Recipients Dim Destinataire As Recipient Dim UnContact As ContactItem Dim Nb As Integer Dim Ns As NameSpace Dim Carnet As MAPIFolder Dim V As Object Set Ns = GetNamespace("MAPI") Set Carnet = Ns.GetDefaultFolder(olFolderContacts) 'Recherche dans les contacts personnels 'Set Carnet=Ns.GetDefaultFolder(olPublicFoldersAllPublicFolders).folders("Fournisseurs") 'Recherche dans les contacts partagés Set Courriel = Item Set Destinataires = Courriel.Recipients ' ENREGISTREMENT DES CONSULTATIONS DE CHAQUE CONTACT ' Pour tous les destinataires du courriel For Each Destinataire In Destinataires ' Rechercher dans les contacts For Each V In Carnet.Items If TypeName(V) = "ContactItem" Then 'Vérifier s'il s'agit d'un ContactItem Set UnContact = V If UnContact.Email1Address = Destinataire.Address _ Or UnContact.Email2Address = Destinataire.Address _ Or UnContact.Email3Address = Destinataire.Address Then ' Destinataire trouvé If UnContact.Body = "" Then ' Ajouter la première consultation dans Notes du contact UnContact.Body = "1. " & Format(Now(), "dddddd") & " - De " & Courriel.Session.CurrentUser.Name & " - Objet : " & Courriel.Subject UnContact.Save Else ' Ajouter la dernière consultation à la liste dans Notes du contact Dim Separation As Variant Separation = Split(UnContact.Body, ". ", , vbTextCompare) 'Extrait chiffre de la première ligne ' Separation(0) représente le premier nombre UnContact.Body = (Separation(0) + 1) & ". " & Format(Now(), "dddddd") & " - De " & Courriel.Session.CurrentUser.Name & " - Objet : " & Courriel.Subject & vbCrLf & UnContact.Body Dim Nbre_lignes As Integer Nbre_lignes = UBound(Split(UnContact.Body, "Objet")) 'Compteur de lignes If Nbre_lignes > 5 Then 'S'il existe plus de 5 lignes '__________________________________________________________________________________ Dim i As Long Dim tableauDeString As String ' Récupération du tableau tableauDeString = Split(UnContact.Body, vbCrLf) ' Traitement pour supprimer les lignes tableauDeString = DeleteLine(tableauDeString, 1) ' Reconversion en string : For i = 0 To UBound(tableauDeString) If i > 0 Then UnContact.Body = UnContact.Body & vbCrLf End If UnContact.Body = UnContact.Body & tableauDeString(i) Next i '__________________________________________________________________________________ End If UnContact.Save End If Exit For End If End If Next V Next Destinataire End Sub