1) "Olivetti d-Copia 2500MF KX su Ne00:"
2)"Lexmark Optra E310 (MS) su LPT1:"
e il codice è
- Codice: Seleziona tutto
Dim rng, cl, INIZIALE, RIGAINIZIALE, NRIGAFINALE, RIGAFINALE, RV, rr, ROWFINALE
Sub Oval1_Click() 'stampa automaticamente tutti i nominativi in ordine alfabetico pronti per essere attaccati sulla rubrica
'
On Error Resume Next
'
Sheets("archivio").Select
Range("A3:D1312").Select
Selection.Copy
Sheets("stampa rubrica").Select
Range("A1").Select
ActiveSheet.Paste Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'
Range("A1:D10000").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal
Range("A1").Select
'
If Range("A1").Value = "." Then
Set rng = Sheets("stampa rubrica").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
rr = 0
RIGAINIZIALE = Range("A2").Address
Rows("1:1").Select
Selection.EntireRow.Hidden = True
Else
Set rng = Sheets("stampa rubrica").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
rr = 0
RIGAINIZIALE = Range("A1").Address
End If
'
For i = 65 To 90
INIZIALE = Chr(i)
'
For Each cl In rng
If cl <> "" And Left(cl, 1) = INIZIALE Then
cl.Select
rr = rr + 1
riga = ActiveCell.Address
Row = ActiveCell.Row
End If
Next
'
Range("A" & Row).Offset(1, 0).Select
RIGAFINALE = Selection.Address
ROWFINALE = Selection.Row
'
RV = Range("G6").Value - (rr Mod Range("G6").Value)
If RV = Range("G6").Value Then RV = 0
Range("A" & Row + 1 & ":E" & Row + RV).Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'
Range(RIGAINIZIALE & ":E" & Row + RV).Select
Selection.PrintOut
'
Range(RIGAFINALE & ":E" & ROWFINALE + RV - 1).Select
Selection.Delete shift:=xlUp
'
Range(RIGAFINALE).Select
'
If Selection.Value <> "" Then
Set rng = Sheets("stampa rubrica").Range("A" & Selection.Row & ":A" & Range("A" & Rows.Count).End(xlUp).Row)
rr = 0
RIGAINIZIALE = RIGAFINALE
Else
Exit For
End If
'
Next
'
Rows("1:1").EntireRow.Hidden = False
MsgBox "Stampa ultimata"
'
Exit Sub
'
End Sub