Need Help with this procedure

English
#1

I am trying to implement a procedure but without success. The goal of the procedure is to copy the selection of a List Box to the clipboard.
.
This list is fed by a SQL query: SELECT “UserName”, “UserID” FROM “TUsers” ORDER BY “UserName” ASC.
.
The data field of this list “IDUser” is associated with the table field of another table “TServicesMP”.
.
The procedure succeeds in finding the selection, but cannot copy it to the clipboard without generating errors like this one:
.
BASIC runtime error.
Undefined object variable.
Code line: oDataFlavor.initialize(“text/plain;charset=utf-8”).
.
Could some of you help me to correct what is not working.
.
Here is the procedure:

Sub CopyListBoxTextToClipboard(oEvent As Object)
    Dim oForm As Object
    Dim oListBox As Object
    Dim sSelectedText As String
    Dim oClipboard As Object
    Dim selectedID As Variant
    Dim oStatement As Object
    Dim oResultSet As Object
    Dim sSQL As String
    
    ' Obtenir le formulaire dans lequel se trouve la List Box
    oForm = oEvent.Source.Model.Parent
    
    ' Obtenir la List Box (zone de liste) dans le formulaire
    oListBox = oForm.getByName("lst-Utilisateurs") ' Assure-toi que le nom de la liste est correct
    
    ' Récupérer l'ID de l'utilisateur sélectionné
    selectedID = oListBox.CurrentValue  ' Utiliser CurrentValue pour obtenir directement la valeur
    
    ' Vérifier si un utilisateur a été sélectionné
    If Not IsNull(selectedID) Then
        ' Construire la requête pour obtenir le texte (NomUtilisateur) à partir de l'ID sélectionné
        sSQL = "SELECT ""NomUtilisateur"" FROM ""TUtilisateurs"" WHERE ""UtilisateurID"" = " & selectedID
        oStatement = oForm.ActiveConnection.createStatement()
        oResultSet = oStatement.executeQuery(sSQL)
        
        ' Vérifier si la requête retourne un résultat
        If oResultSet.next() Then
            sSelectedText = oResultSet.getString(1)  ' Obtenir le NomUtilisateur
            
            ' Obtenir le service Clipboard
            oClipboard = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
            Dim oTransferable As Object
            oTransferable = CreateUnoService("com.sun.star.datatransfer.Transferable")

            ' Créer un DataFlavor pour le texte
            Dim oDataFlavor As Object
            oDataFlavor = CreateUnoService("com.sun.star.datatransfer.DataFlavor")
            oDataFlavor.initialize("text/plain;charset=utf-8")

            ' Définir le texte à copier
            oTransferable.setDataFlavor(oDataFlavor)
            oTransferable.Data = sSelectedText
            
            ' Copier le texte dans le presse-papier
            oClipboard.setTransferable(oTransferable)

            ' Message de confirmation
            MsgBox "Le nom d'utilisateur '" & sSelectedText & "' a été copié dans le presse-papier."
        Else
            MsgBox "Aucun utilisateur correspondant trouvé."
        End If
    Else
        MsgBox "Aucun utilisateur sélectionné."
    End If
End Sub
#2

code from where ? looks like AI globish :wink:

not much of service nor initialize() in LibreOffice: DataFlavor Struct Reference

more likely working from this thread Forum OpenOffice LibreOffice NeoOffice - [Résolu][Basic] Spécifier une dataFlavor pour insertTransferable - (Consulter le sujet)

	dim oFlavor as new com.sun.star.datatransfer.DataFlavor
	oFlavor.MimeType = RTF_TYPE
   	oFlavor.HumanPresentableName = FlavorName
   	oFlavor.DataType=FlavorDataType
#3

You are right. I implemented part of the code, up to the line of code where sSelectedText takes the value of the selected row in the List Box, after that everything I had did not work. I thought that ChatGPT might have a solution, but probably never having encountered this situation, it erred and the procedure is the not fonctionnal result.
.
However, I found the code that give part of the solution on this AskLibreOffice site. I gave this code to ChatGPT as well as the problematic procedure and asked him if there were any solutions with this code to solve the problem. Here is the code found:

Option Explicit

Global sTxtCString As String

Sub CopyToClipBoard(sText)
  Dim oClip As Object, oTrans As Object  'transferable object to set as new content
  oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
  oTrans = createUnoListener("Tr_", "com.sun.star.datatransfer.XTransferable")
  oClip.setContents(oTrans, Null)
  sTxtCString = sText
End Sub

Function Tr_getTransferData(aFlavor As com.sun.star.datatransfer.DataFlavor)
  If (aFlavor.MimeType = "text/plain;charset=utf-16") Then
    Tr_getTransferData() = sTxtCString
  Else
    Tr_getTransferData = Empty
  End If
End Function

Function Tr_getTransferDataFlavors()
  Dim aFlavor As New com.sun.star.datatransfer.DataFlavor
  aFlavor.MimeType = "text/plain;charset=utf-16"
  aFlavor.HumanPresentableName = "Unicode-Text"
  Tr_getTransferDataFlavors() = Array(aFlavor)
End Function

Function Tr_isDataFlavorSupported(aFlavor As com.sun.star.datatransfer.DataFlavor) As Boolean
  If aFlavor.MimeType = "text/plain;charset=utf-16" Then
    Tr_isDataFlavorSupported = True
  Else
    Tr_isDataFlavorSupported = False
  End If
End Function

Sub Test
  CopyToClipBoard "LibreOffice 🙂"
End Sub

I suppose that ChatGPT analyze the code found and my existing procedure. Anyway, the result to my great surprise, is perfectly functional. I click a ‘Copy’ button associated with this procedure in the form and voila, the line selected in the drop-down list is copied and can be pasted anywhere, in a Google search, a Text document, in another field of the database. This is exactly the result I wanted.
.
I have to thank Sokol92 (How do you copy text to clipboard from macro? - #7 by george37809) and ChatGPT for finding the solution to my problem.

Here is the solution :slight_smile:

Option Explicit

Global sTxtCString As String

Sub CopyListBoxTextToClipboard(oEvent As Object)
    Dim oForm As Object
    Dim oListBox As Object
    Dim sSelectedText As String
    Dim selectedID As Variant
    Dim oStatement As Object
    Dim oResultSet As Object
    Dim sSQL As String
    
    ' Obtenir le formulaire dans lequel se trouve la List Box
    oForm = oEvent.Source.Model.Parent
    
    ' Obtenir la List Box (zone de liste) dans le formulaire
    oListBox = oForm.getByName("lst-Utilisateurs")
    
    ' Récupérer l'ID de l'utilisateur sélectionné
    selectedID = oListBox.CurrentValue  ' Utiliser CurrentValue pour obtenir directement la valeur
    
    ' Vérifier si un utilisateur a été sélectionné
    If Not IsNull(selectedID) Then
        ' Construire la requête pour obtenir le texte (NomUtilisateur) à partir de l'ID sélectionné
        sSQL = "SELECT ""NomUtilisateur"" FROM ""TUtilisateurs"" WHERE ""UtilisateurID"" = " & selectedID
        oStatement = oForm.ActiveConnection.createStatement()
        oResultSet = oStatement.executeQuery(sSQL)
        
        ' Vérifier si la requête retourne un résultat
        If oResultSet.next() Then
            sSelectedText = oResultSet.getString(1)  ' Obtenir le NomUtilisateur
            
            ' Copier le texte dans le presse-papier
            CopyToClipBoard(sSelectedText)
            
            ' Message de confirmation
            MsgBox "Le nom d'utilisateur '" & sSelectedText & "' a été copié dans le presse-papier."
        Else
            MsgBox "Aucun utilisateur correspondant trouvé."
        End If
    Else
        MsgBox "Aucun utilisateur sélectionné."
    End If
End Sub

Sub CopyToClipBoard(sText)
    Dim oClip As Object, oTrans As Object  'transferable object to set as new content
    oClip = CreateUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
    oTrans = createUnoListener("Tr_", "com.sun.star.datatransfer.XTransferable")
    oClip.setContents(oTrans, Null)
    sTxtCString = sText
End Sub

Function Tr_getTransferData(aFlavor As com.sun.star.datatransfer.DataFlavor)
    If (aFlavor.MimeType = "text/plain;charset=utf-16") Then
        Tr_getTransferData() = sTxtCString
    Else
        Tr_getTransferData = Empty
    End If
End Function

Function Tr_getTransferDataFlavors()
    Dim aFlavor As New com.sun.star.datatransfer.DataFlavor
    aFlavor.MimeType = "text/plain;charset=utf-16"
    aFlavor.HumanPresentableName = "Unicode-Text"
    Tr_getTransferDataFlavors() = Array(aFlavor)
End Function

Function Tr_isDataFlavorSupported(aFlavor As com.sun.star.datatransfer.DataFlavor) As Boolean
    If aFlavor.MimeType = "text/plain;charset=utf-16" Then
        Tr_isDataFlavorSupported = True
    Else
        Tr_isDataFlavorSupported = False
    End If
End Function

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.