[RESUELTO] Renombrar hoja según nombre de archivo

Discute sobre la aplicación de hojas de cálculo

[RESUELTO] Renombrar hoja según nombre de archivo

Notapor albfernan » Lun Ago 27, 2018 7:56 am

Tengo varias carpetas en Windows que dentro contienen uno o mas ficheros ods, quisiera renombrar la pestaña de cada fichero ods por el mismo nombre del fichero, ¿sabéis si es posible?

Código: Seleccionar todo   Expandir vistaContraer vista
carpeta1
    fichero1(nombre pestaña xx, cambiar a fichero1)
carpeta2
    fichero1(nombre pestaña xx, cambiar a fichero1)
    fichero2(nombre pestaña xx, cambiar a fichero2)
carpeta3
    fichero1(nombre pestaña xx, cambiar a fichero1)
etc...
Última edición por albfernan el Mar Ago 28, 2018 9:27 am, editado 1 vez en total
lo 5.3.0.3 | win 7
albfernan
 
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm

Re: Renombrar hoja según nombre de archivo

Notapor albfernan » Lun Ago 27, 2018 11:03 am

bueno, estoy avanzando, me falta que lea los ficheros de las subcarpetas y que se guarden los cambios al cerrar el archivo que no lo hace y no entiendo porque.

Código: Seleccionar todo   Expandir vistaContraer vista
Sub EjemploDir()
    Dim cArchivo As String
    Dim ruta As String
    Dim cArchivoSinExt As String
    ruta="D:\OFICIOS\"
   
    cArchivo = Dir(ruta + "*.ods", 0)

    Do While cArchivo>""
       'MsgBox cArchivo
       'cArchivo=Dir
       
        'abrimos el archivo
        Url = convertToUrl(ruta + cArchivo)
        'MsgBox Url
   Dim Doc
   Doc = starDeskTop.loadComponentFromUrl (Url, "_blank", 0, Array())
       
        'renombramos la hoja por el nombre del archivo
        Dim oSheet
   oSheet = ThisComponent.CurrentController.ActiveSheet
   cArchivoSinExt=Replace(cArchivo,".ods","")
     'cArchivoSinExt = join(split(cArchivo, ".ods"), NewPart)
      
   MsgBox cArchivoSinExt
   oSheet.Name = cArchivoSinExt
       
        'cerramos salvando el archivo
        Doc.close(true)
        'fnSave = true
        'fnClose = true
        'ThisComponent.Close(True)
       
        cArchivo=Dir
    Loop

    MsgBox "No quedan más archivos"

End Sub

lo 5.3.0.3 | win 7
albfernan
 
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm

Re: Renombrar hoja según nombre de archivo

Notapor FJCC-ES » Lun Ago 27, 2018 2:41 pm

albfernan escribió:me falta que ... se guarden los cambios al cerrar el archivo


Doc.close(true) cierra el archivo. Para guardarlo, use
Código: Seleccionar todo   Expandir vistaContraer vista
Doc.store()
FJCC-ES
 
Mensajes: 691
Registrado: Mié Mar 25, 2009 1:19 am
Ubicación: Colorado, USA

Re: Renombrar hoja según nombre de archivo

Notapor albfernan » Mar Ago 28, 2018 8:17 am

FJCC-ES escribió:
albfernan escribió:me falta que ... se guarden los cambios al cerrar el archivo


Doc.close(true) cierra el archivo. Para guardarlo, use
Código: Seleccionar todo   Expandir vistaContraer vista
Doc.store()


funciona, muchas gracias
lo 5.3.0.3 | win 7
albfernan
 
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm

Re: [RESUELTO] Renombrar hoja según nombre de archivo

Notapor albfernan » Mar Ago 28, 2018 9:28 am

Bueno pues al final lo he terminado, me ha costado más ya que no fui capaz de utilizar el Dir anidado que era lo que tenia en mente, así que leí el contenido de la carpeta y lo guarde en un array que luego recorro abriendo los archivos. Tampoco se crear un array con indice variable así que lo dejé fijo a 100 ya que el directorio contenía menos carpetas.
Me ha funcionado perfectamente, dejo el código:

Código: Seleccionar todo   Expandir vistaContraer vista
'lista un directorio dado y guarda las carpetas que contiene en un array
'recorremos el array de carpetas y leemos los ficheros que contiene
'se renombran las hojas de cada fichero por el nombre del mismo
Sub DirRenSheet()
   'creamos un array con las carpetas a leer
    Dim cDir As String
    Dim conta As Integer
    Dim arrayCarpetas(100) As Variant
    Dim path As String
    path="D:\OFICIOSP\"
    conta=-1
    cDir = Dir(path, 16)

    Do While cDir>""
       Select Case Left(cDir,1)
         'Nos saltamos los ocultos
         Case ".", ".."
         Case Else
                conta=conta+1
                arrayCarpetas(conta) = cDir
               'MsgBox conta & "-" & cDir
      End Select
       'siguiente directorio
       cDir=Dir
    Loop
    'MsgBox "No quedan más carpetas"
   
    'recorremos el array de carpetas y procesamos los ficheros que contienen
    Dim co1 As Integer
     'msgbox(LBound(MyArray()))
     'msgbox(UBound(MyArray()))
    For co1 = 0 To conta
       'MsgBox co1 & "-" & arrayCarpetas(co1)
       Dim cArchivo As String
       Dim cArchivoSinExt As String
       Dim carpeta As String
       carpeta=arrayCarpetas(co1)+"\"
       'MsgBox carpeta
       cArchivo = Dir(path+carpeta+"*.ods", 0)
      'MsgBox cArchivo
       Do While cArchivo>""
           'abrimos el archivo
           Url = convertToUrl(path+carpeta+cArchivo)
         Dim Doc
         Doc = starDeskTop.loadComponentFromUrl (Url, "_blank", 0, Array())
          
           'renombramos la hoja por el nombre del archivo
           Dim oSheet
         oSheet = ThisComponent.CurrentController.ActiveSheet
         cArchivoSinExt=Replace(cArchivo,".ods","")
           'cArchivoSinExt = join(split(cArchivo, ".ods"), NewPart)
         'MsgBox cArchivoSinExt
         oSheet.Name = cArchivoSinExt
          
           'guardamos y cerramos el archivo
           Doc.store()
           Doc.close(true)
           'siguiente archivo
           cArchivo=Dir
       Loop
       'MsgBox "No quedan más archivos"
    Next

End Sub
lo 5.3.0.3 | win 7
albfernan
 
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm


Volver a Calc

¿Quién está conectado?

Usuarios navegando por este Foro: lfiorelli y 6 invitados