[Risolto] macro Incolla i valori filtrati nel file 2

[chimico]

Saluti.
Ho un altro bisogno che non ho potuto risolvere, ho bisogno di Incollare nel Foglio 2 del File 2 i valori filtrati.
Dettagli:

• Nel File 1 c'è già una macro creata dal sr. Patel sull'argomento viewtopic.php?f=26&t=9466.
• La macro corrente copia i valori visibili dal foglio di lavoro 1 e incolla i valori nella prima cella vuota nel foglio di lavoro 2 dello stesso file.
• Se fai clic sul pulsante puoi vedere come viene eseguita la macro corrente.

Nuovo problema:

• Ora ho bisogno della macro corrente per incollare i valori visibili nel Foglio 2 del File 2.
• Il processo di copia e incolla dovrebbe essere lo stesso della macro, ma ora dovresti incollare i valori nel Foglio 2 del File 2.

Osservazioni:

• Dopo Incolla, il cursore dovrebbe mantenere la posizione all'origine, cioè nel file 1.
• I due file per i test sono allegati.

Abbraccio gli amici.

[charlie]

Editato: Il testo del post precedente è stato riformattato. @chimico sei invitato a scrivere i post rispettando la maiuscole e la punteggiatura della lingua italiana e a dare una forma armonica e comprensiva al testo. Grazie.

[chimico]

sr. charlie ,

grazie per la guida.

abbracci.

[Gaetanopr]

Buonasera, prova con questa macro, naturalmente devi cambiare l'indirizzo del file 2

Codice: Seleziona tutto

sub copiafiltro

   oDoc = ThisComponent
   sheet1= thiscomponent.sheets(0)
   
Dim Doc As Object
Dim Url As String
Dim Args(1) as New com.sun.star.beans.PropertyValue 
Args(0).Name="Hidden"
Args(0).Value= False
Args(1).Name = "AsTemplate"
Args(1).value = False
 
 
file2 = StarDesktop.LoadComponentFromUrl( ConvertToURL( "D:\Users\Gaetano\Desktop\File 2.ods" ) ,   "_blank", 0, Args() ) 

   Sheet2= file2.sheets(1)             'secondo foglio del file2

   oCursor = Sheet1.createcursor
   oCursor.gotoendofusedarea(false)
   nEndrow = oCursor.rangeaddress.Endrow
   oCursor = Sheet2.createcursor
   oCursor.gotoendofusedarea(false)
   LR2 = oCursor.rangeaddress.Endrow + 2 
      
   'rng1= sheet1.getcellrangebyPosition(0,1,4,nEndrow) 
   'rng2= sheet1.getcellrangebyPosition(8,1,11,nEndrow)
   'rng3= sheet1.getcellrangebyPosition(20,1,22,nEndrow)
   
   ColRigheOr =  Array(0, 4, 8, 11, 20, 22)
   ColDes = Array(0, 4, 5, 8, 9, 11)
   
   For y = 0 To 5 step 2
     rng = sheet1.getcellrangebyPosition(ColRigheOr(y),1, ColRigheOr(y+1), nEndrow) 
     RigaIn = LR2
     oVisibles = rng.queryVisibleCells()  
     e = oVisibles.createEnumeration()
     while e.hasMoreElements()
         rg = e.nextElement()
         a() = rg.getDataArray()
         RigaFin = RigaIn+Ubound(a)
         Sheet2.getCellRangeByPosition(ColDes(y), RigaIn, ColDes(y+1), RigaFin).setdataarray(a())
         RigaIn = RigaFin+1
     wend
   Next y  

   Sheet2.Columns.OptimalWidth  = True

    file2.store
    file2.close(true)
end sub

PS: A fine copia il file 2 viene salvato e chiuso
Saluti

[chimico]

saluti sr. Gaetanopr ,

         Prima di tutto, voglio ringraziarti per avermi aiutato con questo problema .

         osservazione :

         1) la macro non ha bisogno di aprire il file 2, poiché il file 2 è già aperto al momento dell'operazione, quindi è necessario eseguire l'operazione già aperta .
           
         2) la macro sta incollando i valori nella seconda riga vuota della colonna, cioè sta saltando una riga, quindi è necessario incollare i valori nella prima riga vuota della colonna .

         3) la macro non ha bisogno di salvare e chiudere il file 2, perché dopo l'operazione macro dovrò ancora lavorare sul file 2 .

         4) la macro dovrebbe tornare alla posizione di partenza nel file 1, come già avviene ora .


Grazie mille, amico, per l'aiuto .

[Gaetanopr]

Cambia con questa

Codice: Seleziona tutto

sub copiafiltro

   oDoc = ThisComponent
   sheet1= thiscomponent.sheets(0)
   
Dim Doc As Object
Dim Url As String
Dim Args(1) as New com.sun.star.beans.PropertyValue 
Args(0).Name="Hidden"
Args(0).Value= False
Args(1).Name = "AsTemplate"
Args(1).value = False
 
 
file2 = StarDesktop.LoadComponentFromUrl( ConvertToURL( "D:\Users\Gaetano\Desktop\File 2.ods" ) ,   "_default", 0, Args() ) 

   Sheet2= file2.sheets(1)             'secondo foglio del file2

   oCursor = Sheet1.createcursor
   oCursor.gotoendofusedarea(false)
   nEndrow = oCursor.rangeaddress.Endrow
   oCursor = Sheet2.createcursor
   oCursor.gotoendofusedarea(false)
   LR2 = oCursor.rangeaddress.Endrow + 2 
      
   'rng1= sheet1.getcellrangebyPosition(0,1,4,nEndrow) 
   'rng2= sheet1.getcellrangebyPosition(8,1,11,nEndrow)
   'rng3= sheet1.getcellrangebyPosition(20,1,22,nEndrow)
 Dim RangeOrigine As Object
 Dim CellaDestino As New com.sun.star.table.CellAddress
  
   ColRigheOr =  Array(0, 4, 8, 11, 20, 22)
   ColDes = Array(0, 4, 5, 8, 9, 11)
   
   For y = 0 To 5 step 2
     rng = sheet1.getcellrangebyPosition(ColRigheOr(y),1, ColRigheOr(y+1), nEndrow) 
     RigaIn = LR2 - 1
     oVisibles = rng.queryVisibleCells()  
     e = oVisibles.createEnumeration()
     while e.hasMoreElements()
         rg = e.nextElement()
         a() = rg.getDataArray()
         RigaFin = RigaIn+Ubound(a)
         Sheet2.getCellRangeByPosition(ColDes(y), RigaIn, ColDes(y+1), RigaFin).setdataarray(a())
         RigaIn = RigaFin+1
     wend
   Next y  


   Sheet2.Columns.OptimalWidth  = True
   oDoc.CurrentController.Frame.ContainerWindow.toFront()
   end sub

ps: ora dovrebbe andare bene pure per il 4° punto

Saluti

[chimico]

[RISOLTO]

sr. Gaetanopr ,

la macro ha svolto il compito perfetto .

Grazie mille, amico mio.


abbracci

[Gaetanopr]

Di nulla

Saluti

[patel]

Ciao Gaetano, bentornato su forum !!!

[Gaetanopr]

Ciao patel, grazie!