Vincular 300 archivos en 1

[jANNY]

Hoa, espero puedan ayudarme. Se pintaron 358 fachadas y para vaciar datos se creo un archivo por cada fachada, todos con el mismo formato por lo que la celda del total es la misma en todos (G45)y se les asigno la clave LE-001(nombre del archivo) y asi sucesivamente. El problema es que tengo que hacer una tabla resumen con los totales de cada uno de los archivos, hay alguna forma de poder hacer esto si tener que vincular manualmente cada uno de los archivos? Gracias!

[PepeOooSevilla]

Hola.
Te damos la bienvenida al Foro y, por favor, no dejes de leer la Guía de supervivencia.

Adjunto un archivo con una macro que recorre todos los archivos de la carpeta que se le especifique (celda B5). Por cada archivo Calc que encuentre (ODS) lee la celda especificada (B11) de la hoja correspondiente (B8) y crea una fórmula (enlace) en un nuevo documento Calc con ese contenido. Así puedes revisar si están todos lo que son y son todos los que están. De esta manera tienes en un sólo archivo todos los enlaces a todos los archivos ODS que se encuentren en la carpeta especificada. Obviamente, los nombres de la celda y la hoja tienen que ser el mismo en todos los documentos, el nombre del archivo da igual ya que recorre todos los archivos.

Código: Seleccionar todo

REM *** BASIC ***
Option Explicit

Sub LeerCeldaArchivoCalc()
	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" 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

Si tu firma está actualizada y trabajas con OpenOffice 3.1 entonces tendrás que incluir esta función en la macro:

Código: Seleccionar todo

Function Replace(Source As String, Search As String, NewPart As String)
	Dim Result As String
	Dim StartPos As Long
	Dim CurrentPos As Long
	
	Result = ""
	StartPos = 1
	CurrentPos = 1
	
	If Search = "" Then
	Result = Source
	Else 
	Do While CurrentPos <> 0
		CurrentPos = InStr(StartPos, Source, Search)
		If CurrentPos <> 0 Then
		Result = Result + Mid(Source, StartPos, _
		CurrentPos - StartPos)
		Result = Result + NewPart
		StartPos = CurrentPos + Len(Search)
		Else
		Result = Result + Mid(Source, StartPos, Len(Source))
		End If                ' Position <> 0
	Loop 
	End If 
	
	Replace = Result
End Function

Esta función está extraída de la página Strings (OpenOffice.org BASIC Runtime Library).

Como podrás observar las macros te dan mucho poder (se ahorra mucho trabajo) y si te interesa la programación para OpenOffice/LibreOffice tienes que leer el libro Aprendiendo OOo Basic de nuestro compañero mauricio .
También en las páginas Manuales de Apache OpenOffice en español: Basic y, Basic OpenOffice: Apache OpenOffice Basic en español de nuestro compañero SLV-es, encontrarás muy buena información.

Y, por último, recuerda que si consideras que el tema ha sido resuelto, bien por las respuestas dadas o bien por que has descubierto la solución (en este caso deberías compartirla con la comunidad) tienes que indicarlo (¿Cómo marcar como RESUELTO un tema?), ya que, de esta forma, conseguiremos un Foro más ordenado.
Saludos cordiales.

[fornelasa]

Otra forma de hacerlo, con formulas .....
(adicional a la excelente macro de PepeOooSevilla )
Saludos.