[ Pannello di Controllo Moderatore ]
Option VBASupport 1
Public Sub copiaincolla()
CompatibilityMode(True) '<<<<<<<<<<<<
'dichiaro le variabili
Dim wk1 As Workbook
Dim wk2 As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng As Range
'gestione errori
On Error GoTo RigaErrore
Application.ScreenUpdating = False
MsgBox "ATTENZIONE - ATTENZIONE - ATTENZIONE!!!!" _
& Chr(10) _
& Chr(10) _
& "E' stato scaricato il file aggiornamentoDB" _
& Chr(10) _
& Chr(10) _
& "dal sito e messo nella cartella o dove è posizionato" _
& Chr(10) _
& Chr(10) _
& "il log per avere tutto aggiornato?" _
& Chr(10) _
& Chr(10) _
& Chr(10) _
& "Se non è stato fatto confermate la finestra che" _
& Chr(10) _
& Chr(10) _
& " vi esce e provvedete immediatamente!!"
'sproteggi '<<<<<<<<<<<<<<<<<<<<<
'metto i riferimenti ai files
'Log di stazione
Set wk1 = ThisWorkbook
'metto il riferimento al foglio
Set sh1 = wk1.Worksheets("database")
With sh1
'pulisco il database del log
.Range("a2:d5000").Clear
End With
'file aggiornato esterno al log che si è scaricato
'dal sito e va messo nella stessa cartella o posizione del log
Set wk2 = Workbooks.Open(wk1.Path & "/" & "aggiornamentoDB.xlsx")
'file aggiornato esterno al log che si è scaricato
'dal sito e va messo nel disco C
'Set wk2 = Workbooks.Open("C:\aggiornamentoDB.xlsx")
'metto il riferimento al fogli
Set sh2 = wk2.Worksheets("aggiornamentoDB")
With sh2
'copio i dati da un file all'altro
.Range("a2:d5000").Copy Destination:=sh1.Range("a2")
'.Range("G1").Copy Destination:=sh1.Range("G1")
End With
'salvo le modifiche al file FileDue.xls
wk2.Save
'chiudo il file FileDue.xls
wk2.Close
Application.ScreenUpdating = True
'riga sempre eseguita
RigaChiusura:
'Set a Nothing delle variabili oggetto
Set rng = Nothing
Set sh2 = Nothing
Set sh1 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
Exit Sub
'in caso di errore
RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Resume RigaChiusura
'proteggi '<<<<<<<<<<<
End Sub
Non mi hai risposto a questopatel ha scritto:Non capisco il problema, da calc puoi aprire il file excel quindi non ha bisogno di copiare nulla, .....
l'hai usata su Libre ? su OpenOffice non funziona. Libre è molto più avanti riguardo alla compatibilità con excelGennaro ha scritto: Ho usato la tua correzione ma non funziona poichè cancella tutto tutto senza incollare nulla.
Sub Main
dim percorsoEnomefileA,urlFileB,percorso as string
Dim DocB As Object
Dim vuoto as integer
Dim Dummy() 'It is an (empty) array of PropertyValues
DocA=ThisComponent
oSheetA=DocA.Sheets.getByName(fogliofileA)
percorsoEnomefileA=nomefile()
percorso=ricavapercorso(percorsoEnomefileA)
if left(percorso,1)="/" then
percorso=right(percorso,len(percorso)-1)
end if
urlFileB= percorso & nomefileB
fname = ConvertToURL(urlFileB)
DocB = StarDesktop.loadComponentFromURL (fname, "_blank",0, Dummy() )
' DocB= StarDesktop.loadComponentFromURL(urlFileB, "_hidden", vuoto, Dummy)
oSheetB=DocB.Sheets.getByName(fogliofileB)
oCol1B=oSheetB.Columns.getByName(col1B)
oRange1B = oCol1B.queryEmptyCells()
oRango=oRange1B.getbyIndex(oRange1B.count-1)
ultimarigaB=mid(oRango.AbsoluteName,instr(oRango.AbsoluteName,"$" & col1B)+3,instr(oRango.AbsoluteName,":")-instr(oRango.AbsoluteName,"$" & col1B)-3)
Range = oSheetB.getCellRangeByName("B2:D" &ultimarigaB).getDataArray
' nrighe = UBound(Range()) - LBound(Range())
dRange = oSheetA.getCellRangeByName("B2:D" &ultimarigaB)
dRange.setDataArray(Range)
DocB.close(True)
msgbox "Aggiornato"
End Sub
Visitano il forum: Nessuno e 4 ospiti