Gianca532011 ha scritto:Semplice, funzionale e funzionante.
gli utenti con la tua stessa versione di office ti ringrazieranno
Ma specifica che hai office 2007 o superiore perché con 2003 quel codice va "in panne"
ciao
Moderatori: Anthony47, Flash30005
Gianca532011 ha scritto:Semplice, funzionale e funzionante.
=SCARTO(Foglio2!$AF$6;MAX(0;SOMMA(--(LUNGHEZZA(Foglio2!$AF$6:$AF$1000)>0))-80);0;MIN(80;SOMMA(--(LUNGHEZZA(Foglio2!$AF$6:$AF$1000)>0)));1)
' In This workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
Call EndTimer
End Sub
Private Sub Workbook_Open()
Call StartTimer
Call Start2
End Sub
'In Modulo 1
Public RunWhen As Double
Public Const cRunIntervalSecondi = 60 '<<=== in secondi
Public Const cRunWhat = "AggiornaDati"
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single
Public Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSecondi)
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, _
Schedule:=True
End Sub
Public Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, _
Procedure:=cRunWhat, _
Schedule:=False
End Sub
Public Sub AggiornaDati()
Dim WB As Workbook
Dim sh As Worksheet
Dim RngIn As Range
Dim RngOut As Range
Dim iRow As Long
Dim CalcMode As Long
Set WB = Workbooks("ProvaVBA8_1.xlsm") '<<=== da CAMBIARE
Set sh = WB.Sheets("DDEInput") '<<=== da CAMBIARE
Range("c3:c5000").NumberFormat = "0.00000"
Range("D3:D5000").NumberFormat = "0.00000"
Range("E3:E5000").NumberFormat = "h:mm"
With sh
iRow = lastrow(sh, .Range("A:A"))
Set RngIn = .Range("A1:R1")
Set RngOut = .Range("A" & iRow).Offset(1, 0). _
Resize(1, RngIn.Columns.Count)
End With
'On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
RngOut.Value = RngIn.Value
Call StartTimer
'Call StartTimer2
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
Sub Start2()
TimerSeconds = 60 ' how often to "pop" the timer.
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub
Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Sheets("DDEInput").Select
CellaFlag = "O1"
dati = "J2:N2"
DWS = "Foglio2"
CWS = ActiveSheet.Name
Range("c2:c5000").NumberFormat = "0.00000"
Range("d2:d5000").NumberFormat = "0.00000"
Range("e2:e5000").NumberFormat = "h:mm"
Range(dati).Copy
Sheets(DWS).Select
Range("a65536:N65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
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
' In Modulo 2
Sub Eliminadati()
Set sh = ThisWorkbook.Worksheets("DDEInput")
Range("A3:E50000").Select
Selection.ClearContents
End Sub
Public Sub Contadati()
Dim sh As Worksheet
Dim lRiga As Long
Dim lng As Long
Set sh = ThisWorkbook.Worksheets("DDEInput")
With sh
lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
lng = Evaluate("=COUNTA(" & sh.Name & "!A3:A" & lRiga & ")")
MsgBox lng
End With
Set sh = Nothing
End Sub
Sub Cancella()
Set sh = Worksheets("Foglio2")
Range("$A$2:$E$5000").Select
Selection.ClearContents
End Sub
in funzione dei tempi che ti interessano (1-5-15-20 minuti o secondi etc) e relativa numerosità della media .
Public RunWhen As Double
Public Const cRunIntervalSecondi = 60 '<<=== in secondi
Torna a Applicazioni Office Windows
Visitano il forum: Nessuno e 41 ospiti