Hallo Marc,
fangen wir mal vorne an, aber dennoch ist es fast die Mitte.
Code: Alles auswählen
With oQuelle.Sheets.getByName("CallDAT")
ZielMappe.Sheets.getByName("CallDAT").getCellRangeByName("C3").String = .getCellRangeByName("C3").String
ZielMappe.Sheets.getByName("CallDAT").getCellRangeByName("C5").String = .getCellRangeByName("C5").String
Wie oft willst Du denn noch: ZielMappe.Sheets.getByName("CallDAT"), tippen? Dat is blödsinn.
Das macht man
z.B. so
und dies wird gleich am Anfang des Makros nach der Variablen deklaration gemacht, nach
Dadurch ändert sich der eingangs zitierte Code wie folgt
Code: Alles auswählen
With oQuelle.Sheets.getByName("CallDAT")
oZielDat.getCellRangeByName("C3").String = .getCellRangeByName("C3").String
oZielDat.getCellRangeByName("C5").String = .getCellRangeByName("C5").String
Aber selbst das ist noch ne unvorteilhafte Sache, die man verbessern kann.
Da ja die Quell- und Zieladressen der einzelnen Zellen identisch sind, würde ich diese in ein Array packen und dann per Schleife auslesen und abarbeiten. Das würde dann ungefähr so aussehen.
Code: Alles auswählen
dim iBereich as variant
iBereich(13) = array("C3", "C5", "C7", "C9", "C11", "C14", "C18", "C20", "A26", "A27", "A28", "A29", "A30", "A31")
[...]
for ib = 0 to 13
oZielDat.getCellRangeByName(iBereich(ib)).String = oQuellDat.getCellRangeByName(iBereich(ib)).String
next ib
Und hier der überarbeitete Code, habe aber nicht alles geändert was man ändern kann, keine Lust dazu.
Code: Alles auswählen
Option VBASupport 1
Sub Datei_Inhalte_kopieren()
'
' QuellenDatei_Bestand_in_ZielDatei_NeueVersion_kopieren
Dim objAppExcel As Object
Dim objWb As Object
Dim objSH As Object
Dim lngLastrow As Long
Dim ZielMappe As object
dim iBereich as variant
Dim myFileProp(0) as New com.sun.star.beans.PropertyValue
iBereich(13) = array("C3", "C5", "C7", "C9", "C11", "C14", "C18", "C20", "A26", "A27", "A28", "A29", "A30", "A31")
ZielMappe = ThisComponent
oZielDat = ZielMappe.Sheets.getByName("CallDAT")
lngLastrow=ZielMappe.sheets.getByName("Berge").getCellRangeByName("B5:B197").getRows.getCount()
fileToOpen = ChooseAFileName
If fileToOpen = "" Then
MsgBox "Keine Datei ausgewält, Import wird abgebrochen", vbCritical, "Datenimport"
GoTo Ende
End
End If
'Sub DateiVerstecktOeffnen
'myFileProp(0).name="Hidden"
myFileProp(0).value=True
oQuelle = StarDesktop.loadComponentFromURL(fileToOpen, "_blank", 0, myFileProp() )
oQuellDat = oQuelle.Sheets.getByName("CallDAT")
ZielMappe.Sheets.getByName("Datenkopieren").getCellRangeByName("B5").String = "Import begonnen"
' CallDAT Daten übertragen
for ib = 0 to 13
oZielDat.getCellRangeByName(iBereich(ib)).String = oQuellDat.getCellRangeByName(iBereich(ib)).String
next ib
lngLastrow=oQuelle.sheets.getByName("Berge").getCellRangeByName("B5:B197").getRows.getCount()
For varSh = 1 To 6
Select Case varSh
Case 1: varSheet = "144_vom_Berg"
Case 2: varSheet = "430_vom_Berg"
Case 3: varSheet = "23_vom_Berg"
Case 4: varSheet = "144_zum_Berg"
Case 5: varSheet = "430_zum_Berg"
Case 6: varSheet = "23_zum_Berg"
End Select
dim aDatArray()
aDatArray = oQuelle.Sheets.getByName(varSheet).getCellRangeByPosition(2,4,9,lngLastrow).getDataArray
ZielMappe.Sheets.getByName(varSheet).getCellRangeByPosition(2,4,9,lngLastrow).setDataArray(aDatArray)
If varSh <= 3 Then
oSrcRange = oQuelle.Sheets.getByName(varSheet).getCellRangeByPosition(14,4,14,lngLastrow)
oDataArray = oSrcRange.getDataArray ' "kopiere" Daten in Variable
ZielMappe.Sheets.getByName(varSheet).getCellRangeByPosition(14,4,14,lngLastrow).setDataArray(oDataArray)
End If
Next varSh
varSheet = "höher_23_vom_Berg"
oDataArray = oQuelle.Sheets.getByName(varSheet).getCellRangeByName("B5:B14","C5:J14","K5:L14","Q5:Q14")
ZielMappe.Sheets.getByName(varSheet).getCellRangeByName("B5:B14","C5:J14","K5:L14","Q5:Q14").setDataArray(oDataArray)
varSheet = "höher_23_zum_Berg"
oDataArray = oQuelle.Sheets.getByName(varSheet).getCellRangeByName("B5:B14","C5:J14","K5:L14")
ZielMappe.Sheets.getByName(varSheet).getCellRangeByName("B5:B14","C5:J14","K5:L14").setDataArray(oDataArray)
Application.ScreenUpdating = True ' Aktualisierung der Anzeige von Excel ab-, bzw. angeschalten, False Anzeige unterdrückt
ZielMappe.Sheets.getByName("Datenkopieren").getCellRangeByName("B5").Text= " "
oQuelle.Close()
MsgBox "Datenkopieren abgeschlossen", vbInformation, "Datenimport"
Exit Sub
errhandler:
MsgBox "Fehlernr:" & Err.Number & " " & Err.Description
Ende:
End Sub
Function ChooseAFileName() As String
Dim vFileDialog 'Instanz des Service FilePicker
Dim vFileAccess 'Instanz des Service SimpleFileAccess
Dim iAccept as Integer 'Rückgabe vom FilePicker
Dim sInitPath as String 'Der Startpfad
ChooseAFileName=""
'Achtung: Die folgenden Services müssen in dieser Reihenfolge
'aufgerufen werden, sonst wird Basic den vFileDialog nicht wieder entfernen.
vFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
vFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
sInitPath = ConvertToUrl(CurDir) 'Jetzt wird der Startpfad gesetzt.
If vFileAccess.Exists(sInitPath) Then
vFileDialog.SetDisplayDirectory(sInitPath)
End If
iAccept = vFileDialog.Execute() 'Der Dateiauswahldialog wird ausgeführt.
If iAccept = 1 Then 'Prüfung des Rückgabewerts des Dialogs.
ChooseAFileName = vFileDialog.Files(0) 'Rückgabe des Dateinamens, falls
'der Dialog nicht abgebrochen wurde.
End If
vFileDialog.Dispose() 'Der Dialog wird entfernt.
End Function
mw7180 hat geschrieben:
Karolus hat geschrieben:
- 1 benötigst du wirklich VBA-support 1 ?
gute frage, ich hab gelesen das er das gerne möchte um VBA Code laufen zu lassen, ohne hatte ich Probleme so das ich es Standardmäßig reinschreibe.
Da Du wohl die Datei für Calc umschreiben willst/musst, und folglich das Makro nicht in Excel laufen muss, empfehle ich dir dringend, vergess das mit
VBA-support 1 und kümmere dich lieber darum wie das in StarBasic gemacht wird. Eine hilfreiche Anlaufstelle um sich damit zu befassen, findest Du z.B. hier:
StarBasic / OpenOffice.org Basic FAQ
Ich häng dir mal hier ne Datei an, in der ein File- und Folder-Dialog eingebaut ist. Dann hast Du wenigstens schon mal einen Punkt wo Du weniger auf VBA angewiesen bist. Die Datei macht aber nix weiter, es wird also keine Datei z.B. geladen. Aber das dürfte wohl dann auch nicht mehr arg so schwer sein, denn der eben genannte Link wird dir dabei weiterhelfen.
Gruß
balu
