I need to get the last used cell of a column.
I can get the last used row with my test code.
Code: Select all
' LastUsedCell.vbs
' Renvoie les dernières ligne et colonne utilisées d'un classeur Libre Office Cacl.
Option Explicit
GetTest()
Sub GetTest()
Dim args1( 0 ) ' Tableau d'1 ligne pour les paramètres de oDesktop.LoadComponentFromURL()
Dim cMessage ' Message d'affichage du retour.
Dim cUrl ' Nom fichier au format URL.
Dim oDesktop ' Objet créé par oServiceManager.CreateInstance()
Dim oDoc ' Objet du classeur créé par oDesktop.LoadComponentFromURL()
Dim oServiceManager ' Objet Libre Office.
Dim oSheet ' Objet de la feuille
Set oServiceManager = CreateObject( "com.sun.star.ServiceManager" )
cUrl = wr_GetFile( oServiceManager )
If Len( cUrl ) = 0 Then
msgbox "Pas de fichier sélectionné", 0, "Erreur"
End If
Set args1( 0 ) = oServiceManager.Bridge_GetStruct( "com.sun.star.beans.PropertyValue" )
args1( 0 ).name = "Hidden"
args1( 0 ).value = False ' True = n'affiche pas le classeur, False = affiche le classeur.
Set oDesktop = oServiceManager.CreateInstance( "com.sun.star.frame.Desktop" )
Set oDoc = oDesktop.LoadComponentFromURL( cUrl, "_blank", 0, args1 )
Set oSheet = oDoc.GetSheets.GetByIndex( 0 )
cMessage = ""
cMessage = cMessage & "Dernière colonne utilisée du classeur : " & CStr( ca_LastUsedCol( oSheet ) ) & chr( 10 )
cMessage = cMessage & "Dernière ligne utilisée du classeur : " & CStr( ca_LastUsedRow( oSheet ) )
msgbox( cMessage )
Set oServiceManager = Nothing
End Sub
' Renvoie la dernière ligne du classeur sélectionné.
Function ca_LastUsedCol( oSheet )
Dim oCursor
Set oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea( True )
ca_LastUsedCol = oCursor.getRangeAddress.EndColumn
Set oCursor = Nothing
End Function
' Renvoie la dernière ligne du classeur sélectionné.
Function ca_LastUsedRow( oSheet )
Dim oCursor
Set oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea( True )
ca_LastUsedRow = oCursor.getRangeAddress.EndRow
Set oCursor = Nothing
End Function
' Sélectionne un nom de fichier à ouvrir avec Writer au format URL.
Function wr_GetFile( oServiceManager )
Dim aUrl ' Tableau du nom de l'URL sélectionnée.
Dim cDir ' Dossier du départ de la recherche.
Dim cDirWork ' Dossier du script ( travail ).
Dim cUrl ' Nom fichier au format URL.
Dim i ' Numérique de comptage.
Dim oFile ' Objet du fichier de dernier dossier sélectionné.
Dim oFilePicker ' Objet com.sun.star.ui.dialogs.FilePicker.
Dim oFso ' Objet général OLE des fichier.
cDir = ""
cDirWork = Left( WScript.ScriptFullName, InStrRev( WScript.ScriptFullName, "\" ) - 1 )
Set oFso = CreateObject( "Scripting.FileSystemObject" )
If Not oFso.FolderExists( cDirWork & "\Parameters" ) Then oFso.CreateFolder( cDirWork & "\Parameters" )
If oFso.FileExists( cDirWork & "\Parameters\LastDir.txt" ) Then
If oFso.Getfile( cDirWork & "\Parameters\LastDir.txt" ).Size > 0 Then
Set oFile = oFso.OpenTextFile( cDirWork & "\Parameters\LastDir.txt" )
cDir = oFile.Readline()
oFile.Close
If Not oFso.FolderExists( cDir ) Then cDir = ""
End If
End If
If Len( cDir ) = 0 Then cDir = cDirWork
oFilePicker = oServiceManager.CreateInstance( "com.sun.star.ui.dialogs.FilePicker" )
oFilePicker.initialize( Array( 0 ) ) ' FILEOPEN_SIMPLE = 0
oFilePicker.setDisplayDirectory( cDir )
oFilePicker.appendFilter "Tous les fichiers (*.* )", "*.*"
oFilePicker.appendFilter "Calc (*.ods )" , "*.ods"
oFilePicker.appendFilter "Excel (*.xlsx, *.xls )" , "*.xlsx;*.xls"
oFilePicker.appendFilter "Texte ODF (*.odt )" , "*.odt"
oFilePicker.appendFilter "Word (*.docx, *.doc )" , "*.docx;*.doc"
oFilePicker.appendFilter "Texte enrichi (*.rtf )" , "*.rtf"
oFilePicker.appendFilter "Texte (*.txt )" , "*.txt"
cUrl = "" ' Retourne une chaîne vide si pas de sélection.
If oFilePicker.Execute() = 1 Then
aUrl = oFilePicker.Files( 0 )
For i = LBound( aUrl ) To UBound( aUrl )
cUrl = cUrl & aUrl( i )
Next
cDir = bv_UrlToFile( cUrl )
Set oFile = oFso.CreateTextFile( cDirWork & "\Parameters\LastDir.txt", True )
oFile.Writeline Left( cDir, InStrRev( cDir, "\" ) - 1 )
oFile.Close
End If
Set oFso = Nothing
wr_GetFile = cUrl
End Function
' Convertit un nom de fichier URL en nom Windows.
Function bv_UrlToFile( cUrl )
Dim cFile
cFile = cUrl
cFile = Replace( cFile, "file:///", "" )
cFile = Replace( cFile, "/", "\" )
cFile = Replace( cFile, "%20", " " )
cFile = Replace( cFile, "|", ":" )
bv_UrlToFile = cFile
End Function
Thanks,
Bernard