Apache OpenOffice: forum della comunità

Codice: Seleziona tutto

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

Codice: Seleziona tutto

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