Moderatori: Anthony47, Flash30005
Public Sub Dimagrire(Optional sWbName As Variant)
Dim wb As Workbook
Dim sh As Worksheet
Dim rng As Range
Dim iRow As Long
Dim iCol As Long
Dim blOK As Boolean
Dim bScreenUpd As Boolean
Dim bCalc As XlCalculation
On Error GoTo SubFail_
With Application
bScreenUpd = .ScreenUpdating
.EnableEvents = False
.ScreenUpdating = False
bCalc = .Calculation
.Calculation = xlCalculationManual
End With
For Each wb In Workbooks
If IsMissing(sWbName) Then
blOK = True
Else
blOK = wb.Name = sWbName
End If
If blOK Then
For Each sh In wb.Worksheets
With sh
.DisplayPageBreaks = False
iRow = 0
iCol = 0
On Error Resume Next
iRow = LastRow(sh, .Cells)
iCol = LastCol(sh, .Cells)
On Error GoTo SubFail_
If iRow * iCol = 0 Then
.Columns.Delete
Else
If Not iRow = .Rows.Count Then
.Range(.Cells(iRow + 1, 1), _
.Cells(.Rows.Count, 1)). _
EntireRow.Delete
End If
If Not iCol = .Columns.Count Then
.Range(.Cells(1, iCol + 1), _
.Cells(1, .Columns.Count)). _
EntireColumn.Delete
End If
End If
Set rng = .UsedRange
End With
Next sh
End If
Next wb
SubFail_:
With Application
.EnableEvents = True
.ScreenUpdating = bScreenUpd
.Calculation = bCalc
End With
End Sub
criscolo67 ha scritto:Per scossa cosa intendi mettila nel file personal e poi apri ecc ecc. scusa l'ignoranza . ciao
http://rapidshare.com/files/2466495146/PROVA.xls
Function LastRow(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'--------------->
Function LastCol(SH As Worksheet, _
Optional Rng As Range)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastCol = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Torna a Applicazioni Office Windows
cerca il più grande numero di celle vuote in un intervallo Autore: papiriof |
Forum: Applicazioni Office Windows Risposte: 2 |
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Modifica visualizzazione file di una cartella Autore: mastino46 |
Forum: Sistemi Operativi Windows Risposte: 2 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 87 ospiti