Apache OpenOffice: Foro oficial de la comunidad

Código: Seleccionar todo

='file:///D:/CARPETA/ARCHIVO_PRUEBAS_01.ods'#$Hoja1.A1

Código: Seleccionar todo

REM *** BASIC ***
Option Explicit

Sub LeerCeldaArchivoCalc()
'Lee la misma celda de la misma hoja de todos los archivos ODS / XLS
'que se encuentren en la carpeta que se le especifique, pegando la
'información obtenida en un nuevo archivo ODS mediante un enlace
'tipo ='file:///D:/CARPETA/ARCHIVO_PRUEBAS_01.ods'#$Hoja1.A1
	Dim EsteDoc As Object
	Dim EstaHoja As Object
	Dim NuevoDoc As Object
	Dim NuevaHoja As Object
	Dim Carpeta As String
	Dim NomHoja As String
	Dim NomCelda As String
	Dim FilaActual As Long
	Dim Archivo As String
	Dim Extension As String

	On Error Goto TRATAR_ERROR

	EsteDoc = ThisComponent
	EstaHoja = EsteDoc.CurrentController.ActiveSheet
	With EstaHoja
		Carpeta = UCase(.getCellRangeByName("B5").String)
		NomHoja = UCase(.getCellRangeByName("B8").String)
		NomCelda = UCase(.getCellRangeByName("B11").String)
	End With
	' Comprobamos que no esté vacía la RUTA del archivo
	If Trim(Carpeta) = "" Or IsNull(Carpeta) Then
		MsgBox "La RUTA de la CARPETA no debe estar VACÍA", 16, "¡Atención!"
		Exit Sub
	End If
	If Right(Carpeta, 1) <> "\" Then
		Carpeta = Carpeta & "\"
	End If
	If Trim(NomHoja) = "" Or IsNull(NomHoja) Then
		MsgBox "El NOMBRE de la HOJA no debe estar VACÍO", 16, "¡Atención!"
		Exit Sub
	End If
	If Trim(NomCelda) = "" Or IsNull(NomCelda) Then
		MsgBox "La CELDA no debe estar VACÍA", 16, "¡Atención!"
		Exit Sub
	End If
	'Creamos nuevo documento Calc donde se volcarán los resultados
	NuevoDoc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Array())
	NuevaHoja = NuevoDoc.Sheets(0)
	FilaActual = 0
	With NuevaHoja
		.getCellByPosition(0, FilaActual).String = "ARCHIVO"
		.getCellByPosition(1, FilaActual).String = "VALOR"
		Archivo = Dir(Carpeta)
		Do While Archivo <> ""
			Extension = UCase(Right(Archivo, 3))
			If (Extension = "ODS") Or (Extension = "XLS") Then
				FilaActual = FilaActual + 1
				.getCellByPosition(0, FilaActual).String = Carpeta & Archivo
				.getCellByPosition(1, FilaActual).Formula = "=" & Chr(39) & "file:///" & Replace(Carpeta, "\", "/") & _
															Archivo & Chr(39) & "#$" & NomHoja & "." & NomCelda
			End If
			' Leer el siguiente archivo
			Archivo = Dir()
		Loop
	End With
	MsgBox "Macro finalizada", 64, "¡Atención!"
	Exit Sub

TRATAR_ERROR:
' Por si hubiera que tratar los posibles errores
	MsgBox "Se ha producido un ERROR en la ejecución de la macro", 16, "¡Atención!"
End Sub

Código: Seleccionar todo

file:///home/USER/PATH