J'ai une macro qui fonctionne bien mais dont j'aimerai ajouter une fonctionnalité.
Cette macro me permet de sélectionner, depuis le fichier Données (bouton ajout de dossier), une ligne dans mon document 'Dossiers en cours" en fonction des éléments de la colonne B et de la copier/coller dans en ligne 2 du fichier "Données".
Je souhaiterai que la ligne copiée dans le document "Dossiers en cours" soit supprimée après avoir été copiée.
Pourriez-vous m'aider svp ?
Je joins une version allégée et anonymisée des fichiers.
Je vous en remercie par avance.
Bien cordialement
Solaris
Code : Tout sélectionner
Option Explicit
Sub Main
Dim oDoc As Object, Feuilles As Object, F1 As Object, F2 As Object, oDocDest As Object
Dim Zone As Object, Cherche As Object, Trouve As Object
Dim DestURL As String
Dim Mot As String, Ligne As Integer, i As Integer
Dim Args () As new com.sun.star.beans.PropertyValue
Dim U as Variant, n as long
oDoc = ThisComponent
Mot = inputBox("Numéro de RG ?")
Feuilles = oDoc.Sheets
'DestURL = ConvertToUrl("C:/users/ce.ri/desktop/Rédaction/Données.ods")'Adresse du fichier destinataire
' 4 lignes nouvelles
U = split(oDoc.Url, "/")
n = Ubound(U)
U(n) = "Dossiers en cours.ods"
DestURL = join(U, "/")
oDocDest = StarDesktop.loadComponentFromURL(DestURL,"_blank",0 ,Args())
F1 = oDocDest.Sheets.GetByName("Champs")
F2 = Feuilles.GetByName("Champs")
Zone = F1.GetCellRangeByName("B2:B200")
Cherche = Zone.createSearchDescriptor
With Cherche
.SearchString = Mot
.SearchWords = False
End With
Trouve = Zone.FindFirst(Cherche)
i = 1
Do until isnull(Trouve)
Ligne = Trouve.RangeAddress.EndRow
F2.GetCellRangeByPosition(0,i,451,i).DataArray = F1.GetCellRangeByPosition(0,Ligne,451,Ligne).DataArray
Trouve = Zone.FindNext(Trouve,Cherche)
i = i +1
Loop
ThisComponent.store(True)
oDocDest.store
oDocDest.close(True)
End Sub