Verknüpfungen aktuallisieren

[pstoelzg]

Hallo Pums,

ich hoffe, das folgende Code Snippet ist die Lösung zu Deinem Problem.

HINWEIS
!!! Ich habe es nicht getestet !!!

Code: Alles auswählen

REM  *****  BASIC  *****

Option Explicit

REM ============================================================================
REM
REM ============================================================================

Sub copyValsFromSrc
	' Constants
	Const iCOL_B As Integer = 1
	
	' Variables
	Dim iRowIdx As Integer
	Dim iRowIdxEnd As Integer
	Dim oSrcCell As Object
	Dim oSrcDoc As Object
	Dim oSrcSheet As Object
	Dim oThisDoc As Object
	Dim oThisSheet As Object
	Dim sMsg As String
	Dim sSrcFileName As String
	Dim sSrcPathDir As String
	Dim sSrcUrl As String
	
	' Read ini values from spreadsheet 'Sheet2' of This document
	oThisDoc = ThisComponent
	oThisSheet = oThisDoc.getSheets().getByName("Sheet2")
	
	
	
	' Path to source directory
	sSrcPathDir = oThisSheet.getCellRangeByName("A1").String
	' Name of  source file
	sSrcNameFile =  oThisSheet.getCellRangeByName("A2").String
	' Name of required spreadsheet contained by remote/ source file
	sSrcNameSheet =  oThisSheet.getCellRangeByName("A3").String
	
	' Create URL pointing to source file
	sSrcUrl = ConvertToURL(sPathSrcDir + getPathSeparator + sSrcFileName)
	' Check if the above file exists
	If Not FileExists(sSrcUrl) Then
		' Assemble message
		sMsg = "ERROR" & Chr(13) & _
					 "Source file doesn't exist in specified location" & Chr(13) & _
					 "Path: " & sSrcPathDir & Chr(13) & _
					 "File: " & sSrcFileName & Chr(13) & _
					  Chr(13) & _
					 "Routine is going to terminate"
		' Show message
		MsgBox sMsg, 0, "Source file doesn't exist"
		' Terminate execution
		End
	End If
	
	'  Access source file
	oSrcDoc = StarDesktop.loadComponentFromURL(sSrcUrl,  "_blank",  0,  Array())
	' Access spreadsheet 'Sheet1' of source file
	oSrcSheet = oSrcDoc.getSheets().getByName("Sheet1")
	
	' FIXME
	' Spreadsheet source: get index of 'last' cell which contains a value
	' Asign the above value to variable 'iRowIdxEnd'
	
	iRowIdxEnd = 500
	' Set row index
	For iRowIdx = 0 To iRowIdxEnd Step 1
		' Create cell object
		oSrcCell = oSrcSheet.getCellByPosition(iCOL_B, iRowIdx)
		' Check if cell is empty
		If Not oSrcCell.Type = com.sun.star.table.CellContentType.EMPTY Then
			' Read value from source cell and write it to This cell
			oThisSheet.getCellByPosition(iCOL_B, iRowIdx) = oSrcCell.Value
		End If
	Next iRowIdx
	
	
	
	' Delete objects explicitly (NOT necessary, but I like it)
	Set oThisSheet As Object
	Set oThisDoc As Object
	Set oSrcSheet As Object
	Set oSrcDoc As Object
	Set oSrcCell As Object
End Sub