Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

excel

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

excel

Postdi trittico69 » 15/02/11 23:51

questa macro è assegnata a un tasto che stampa di nomi ma non li mette in ordine alfabetico prima della stampa...
il codice che dovrebbe mettere in ordine alfabetico inizia dalla riga 26..
chi me lo sinstema?
grazie!


Sub sta1()
Dim r As Long
Dim r1 As Long
Dim st As String
Dim cp As Long
Dim d As Long
Dim ind As Variant
Dim CL, CL2, RNG, RNG2, NOME, COGNOME
'
Application.ScreenUpdating = False
'
Sheets("FEMMINILE").Select
Set RNG = Range("B5:B200")
For Each CL In RNG
If CL <> "" Then
COGNOME = CL
NOME = CL.Offset(0, 1).Value
Sheets("ARCHIVIO").Select
Set RNG2 = Range("G3:G300")
For Each CL2 In RNG2
If CL2 = COGNOME And CL2.Offset(0, 1).Value = NOME Then
CL2.ClearContents
CL2.Offset(0, 1).ClearContents
CL2.Offset(0, 2).ClearContents
CL2.Offset(0, 3).ClearContents
Range("A2:F" & r).Select ' ordia alfabetico i movimenti'
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("G2:J2").Select 'ordina alfabetico gli entrati'
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("k2:N2").Select 'ordina alfabetico gli usciti'
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
Next
End If
Next

Set sh1 = Worksheets("Archivio")
sh1.Activate
Application.ScreenUpdating = False
st = Cells(2, 16)
cp = Cells(2, 17)
Cells(1, 18) = Cells(Rows.Count, 5).End(xlUp).Row
r1 = Cells(1, 18)
Cells(1, 19) = Cells(Rows.Count, 7).End(xlUp).Row
Cells(1, 20) = Cells(Rows.Count, 11).End(xlUp).Row
Cells(2, 18).Select
ActiveCell.FormulaR1C1 = "=LARGE(R[-1]C:R[-1]C[2],1)"
r = Cells(2, 18)
Range(Cells(1, 18), Cells(2, 20)).ClearContents
If r1 < r Then
If r1 = 2 Then
Range(Cells(r1 + 1, 1), Cells(r, 4)).Select
Selection.Insert Shift:=xlDown
Cells(4, 5).Copy
Range(Cells(r1 + 1, 1), Cells(r, 4)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
Range(Cells(r1 + 1, 1), Cells(r, 4)).Select
Selection.Insert Shift:=xlDown
End If
End If
If r1 < r Then d = r Else d = r1
For x = 3 To d Step 2
Range(Cells(x, 1), Cells(x, 14)).Interior.ColorIndex = 45
Next x

Range("A3:N" & r).Select 'seleziona l'area di stampa'
ind = Range("A3:N" & r).Address
ActiveSheet.PageSetup.PrintArea = ind
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = "Stampato in Data &D - &T Pagine &P/&N" 'stampa data ora e numero di pagine'
.CenterHeader = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & _
"&""Arial,Grassetto Corsivo""&18Direzione N.C.P. Solliciano - Firenze&""Arial,Normale""&10" & Chr(10) & _
"&""Arial,Grassetto Corsivo""&12Variazioni Celle, Nuovi Arrivi, Uscite, in Data &D" 'intestazione pagina'
.LeftMargin = Application.InchesToPoints(0.1) 'margine sinistro della stampa'
.RightMargin = Application.InchesToPoints(0.1) 'margine destro'
.TopMargin = Application.InchesToPoints(1.6) 'margine alto'
.BottomMargin = Application.InchesToPoints(0.25) 'adatta lo scritto alla pagina della stampa'
.HeaderMargin = Application.InchesToPoints(0.1) 'abbassa o alza il titolo della pagina di stampa'
.FooterMargin = Application.InchesToPoints(0.2) 'abbassa o alza lo scritto sotto la pagine'
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape 'stampa in verticale...per stampare in orizzontale sostituisci con =x1portrait'
.Draft = False
.PaperSize = xlPaperA4 'tipo di foglio usati per la stampa'
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100 'ingrandisce o rimpiccolisce la stampa'
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.ScreenUpdating = True
If st = "V" Then ActiveWindow.SelectedSheets.PrintPreview
If st = "S" Then ActiveWindow.SelectedSheets.PrintOut Copies:=cp


If r1 < r Then
Range(Cells(3, 2), Cells(r, 15)).Interior.ColorIndex = 0
Else
Range(Cells(3, 2), Cells(r1, 15)).Interior.ColorIndex = 0
End If
If r1 < r Then

Range(Cells(r1 + 1, 1), Cells(r, 4)).Select
Selection.Delete Shift:=xlUp
End If
Cells(2, 1).Select
End Sub
trittico69
Utente Senior
 
Post: 487
Iscritto il: 16/08/09 18:41

Sponsor
 

Re: excel

Postdi Flash30005 » 16/02/11 09:10

Secondo me, sarebbe più opportuno che pubblicassi il file...
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-


Torna a Applicazioni Office Windows


Topic correlati a "excel":


Chi c’è in linea

Visitano il forum: eliorimnap e 15 ospiti