[RESUELTO] Renombrar hoja según nombre de archivo

Discute sobre la aplicación de hojas de cálculo
Responder
albfernan
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm

[RESUELTO] Renombrar hoja según nombre de archivo

Mensaje por albfernan »

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

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

Mensaje por albfernan »

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

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
FJCC-ES
Mensajes: 873
Registrado: Mié Mar 25, 2009 1:19 am
Ubicación: Colorado, USA

Re: Renombrar hoja según nombre de archivo

Mensaje por FJCC-ES »

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

Doc.store()
albfernan
Mensajes: 23
Registrado: Mar Sep 05, 2017 1:21 pm

Re: Renombrar hoja según nombre de archivo

Mensaje por albfernan »

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

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

Mensaje por albfernan »

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

'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
Responder