Moderatori: Anthony47, Flash30005
Workbooks.Add 'Crea nuovo file
ThisWorkbook.Sheets("Foglio1").Range("A2:H5").Copy 'Copia da file originale
Range("A1").PasteSpecial xlPasteValues 'incolla sul nuovo file, valori ..
Range("A1").PasteSpecial xlPasteFormats '.. e altro che serve; esempio
Range("A1").PasteSpecial xlPasteColumnWidths '.. esempio
'...
'altre cose da copiare
'altre cose da copiare
'...
Application.CutCopyMode = False
Application.DisplayAlerts = False 'Se si usa lo stesso NomeFile
ActiveWorkbook.SaveAs Filename:="C:\PercorsoCompleto\PROVA.htm", _
FileFormat:=xlHtml, ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close , False 'Chiude il file html
Anthony47 ha scritto:In questo tuo progetto la cosa piu' trigosa (secondo me) e' l'upload dei file dal pc al server web, che (per quanto ne so) va fatta con utility di sistema; e mi pare che tu avesi identificato due procedure che avevano la comodita' di poter essere invocate tramite macro. Quale e' invece la procedura Microsoft che ti ha fatto demordere?
Anthony47 ha scritto:Quale e' il vantaggio a usare FTPBox per copiare le cartelle su un altro server?
Anthony47 ha scritto:Immagino che lo aggancerai a una qualche procedura di WorksheetChange, ma io eviterei di trovarmi in situazioni di modifiche da salvare troppo frequenti, perche' creare un file e salvarlo non e' un attimo; e comunque la procedura di aggiornamento sul server web (se riesci ad automatizzarla) potrebbe richiedere "qualche secondo"; e comunque l'utente che consulta i dati sul web non e' che fa il refresh dei suoi dati ogni 10 secondi.
Insomma forse piu' che agganciarla a una WorksheetChange potrebbe essere utile agganciarla a una macro che esegui ogni tot minuti rischedulandola tramite OnTime.
Vedi tu...
Sub Macro3()
'
' Macro3 Macro
'
'
With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = False
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize1024x768
.PixelsPerInch = 96
.Encoding = msoEncodingWestern
End With
With Application.DefaultWebOptions
.SaveHiddenData = True
.LoadPictures = False
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = False
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Users\Marco\Documents\excel\schema entrate OGGI.htm", "ENTRATE", _
"$A$1:$K$161", xlHtmlStatic, "schema entrate OGGI_28591", "Schema Entrate")
.Publish (True)
.AutoRepublish = False
End With
ChDir "C:\Users\Marco\Documents\excel"
End Sub
Sub Avvia()
Tempo = Now + TimeValue("00:01:0")
Application.OnTime Tempo, "Macro3"
End Sub
Sub Macro3()
'
' Macro3 Macro
'
'
With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = False
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize1024x768
.PixelsPerInch = 96
.Encoding = msoEncodingWestern
End With
With Application.DefaultWebOptions
.SaveHiddenData = True
.LoadPictures = False
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = False
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Users\Marco\Documents\excel\schema entrate OGGI.htm", "ENTRATE", _
"$A$1:$K$161", xlHtmlStatic, "schema entrate OGGI_28591", "Schema Entrate")
.Publish (True)
.AutoRepublish = False
End With
Sub Macro3()
'
'..
'..
Tempo = Now + TimeValue("00:01:0")
Application.OnTime Tempo, "Macro3"
End Sub
'RIGOROSAMENTE IN CIMA AL MODULO:
Public Next1Min As Date, Next15Min As Date, Next30Min As Date, Next60Min As Date
Dim StopAll As Boolean 'Stop all the schedules
'
'QUESTA E' LA TUA MACRO PRINCIPALE, quella che hai chiamato Macro3:
Sub OneMinuteMacro() 'This is your 1 minute macro with amendments
If StopAll = False Then ' StopAll??
If Next15Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
'
' >>>> qui il tuo codice da eseguire nella macro <<<<
'
'Then Reschedue myself:
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime NextOneMin, "OneMinuteMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro15Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime Next1Min, "OneMinMacro"
End If
If Next30Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
'Reschedue myself:
NextOneMin = Now + TimeSerial(0, 14, 0)
Application.OnTime NextOneMin, "Macro15Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro30Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next15Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
If Next60Min < (Now - TimeSerial(0, 5, 0)) Then
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
End If
'Reschedue myself:
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub OneHourMacro() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next30Min < (Now - TimeSerial(0, 5, 0)) Then
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
End If
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 1)
Application.OnTime Next1Min, "OneMinuteMacro"
End If
'Reschedue myself:
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Avvia()
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
Call OneMinuteMacro
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End Sub
Anthony47 ha scritto:Lo stesso dicasi quando si vuole chiudere il file (altrimenti rimangono valide le schedulazioni e il file verra' riaperto tra 1 minuto, 15 minuti etc); per questo puoi usare la macro di BeforeClose da inserire nel modulo ThisWorkbook:
- Codice: Seleziona tutto
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Macro2
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Macro2
'
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End Sub
Public Next1Min As Date, Next15Min As Date, Next30Min As Date, Next60Min As Date
Dim StopAll As Boolean 'Stop all the schedules
'
'QUESTA E' LA TUA MACRO PRINCIPALE, quella che hai chiamato Macro3:
Sub OneMinuteMacro() 'This is your 1 minute macro with amendments
If StopAll = False Then ' StopAll??
If Next15Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
'
' With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = True
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize1024x768
.PixelsPerInch = 96
.Encoding = msoEncodingWestern
End With
With Application.DefaultWebOptions
.SaveHiddenData = True
.LoadPictures = False
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = True
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Users\mrosini\Desktop\DA DUPLICARE schema entrate\online\schema-entrate.htm" _
, "ENTRATE", "$A$1:$K$161", xlHtmlStatic, "schema entrate da dup1_6262", _
"Schema Entrate")
.Publish (True)
.AutoRepublish = False
End With
ChDir "C:\Users\mrosini\Desktop\DA DUPLICARE schema entrate\online"
End Sub
'
'Then Reschedue myself:
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime NextOneMin, "OneMinuteMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro15Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime Next1Min, "OneMinMacro"
End If
If Next30Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
'Reschedue myself:
NextOneMin = Now + TimeSerial(0, 14, 0)
Application.OnTime NextOneMin, "Macro15Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro30Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next15Min < (Now - TimeSerial(0, 5, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0)
Application.OnTime Next15Min, "Macro15Min"
End If
If Next60Min < (Now - TimeSerial(0, 5, 0)) Then
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
End If
'Reschedue myself:
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub OneHourMacro() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next30Min < (Now - TimeSerial(0, 5, 0)) Then
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
End If
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 1)
Application.OnTime Next1Min, "OneMinuteMacro"
End If
'Reschedue myself:
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Avvia()
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
Call OneMinuteMacro
End Sub
systemcrack ha scritto:Ma quindi potrei inserire anche un comando inverso per attivare la Oneminutemacro invece che doverla lanciare io manualmente.. ?! Molto molto interessante.. ci giocherello un po' e ti faccio sapere.
Grazie Anthony47 la mia offerta è sempre valida per il pasto offerto in caso tu passi da ravenna. In alternativa se hai modo di ricevere, sarei anche ben lieto di farti una donazione per tutto l'aiuto che mi stai dando
systemcrack ha scritto:Ma quindi potrei inserire anche un comando inverso per attivare la Oneminutemacro invece che doverla lanciare io manualmente.. ?! Molto molto interessante.. ci giocherello un po' e ti faccio sapere.
Grazie Anthony47 la mia offerta è sempre valida per il pasto offerto in caso tu passi da ravenna. In alternativa se hai modo di ricevere, sarei anche ben lieto di farti una donazione per tutto l'aiuto che mi stai dando
Private Sub Workbook_Open()
Call OneMinuteMacro
End Sub
Private Sub Workbook_Open()
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime NextOneMin, "OneMinuteMacro"
End Sub
Private Sub Workbook_Open()
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime NextOneMin, "OneMinuteMacro"
NextOneMin = Now + TimeSerial(0, 14, 0)
Application.OnTime NextOneMin, "Macro15Min"
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
End Sub
'Reschedue myself:
NextOneMin = Now + TimeSerial(0, 14, 0)
Debug.Print "Eseguo Macro15Min", Now '<<< IL NOME giusto della macro
Application.OnTime NextOneMin, "Macro15Min"
Public Next1Min As Date, Next15Min As Date, Next30Min As Date, Next60Min As Date
Dim StopAll As Boolean 'Stop all the schedules
'
'QUESTA E' LA TUA MACRO PRINCIPALE, quella che hai chiamato Macro3:
Sub OneMinuteMacro() 'This is your 1 minute macro with amendments
If StopAll = False Then ' StopAll??
If Next15Min < (Now - TimeSerial(0, 1, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0) '15
Application.OnTime Next15Min, "Macro15Min"
End If
'
With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = True
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize1024x768
.PixelsPerInch = 96
.Encoding = msoEncodingWestern
End With
With Application.DefaultWebOptions
.SaveHiddenData = True
.LoadPictures = False
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = True
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
'>>>>>>CORREGGI I PERCORSI COME DA TUA SITUAZIONE <<<<<
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"D:\PROVA\schema-entrate.htm" _
, "ENTRATE", "$A$1:$K$161", xlHtmlStatic, "schema entrate da dup1_6262", _
"Schema Entrate")
.Publish (True)
.AutoRepublish = False
End With
ChDir "C:\Users\mrosini\Desktop\DA DUPLICARE schema entrate\online" '<<<< SERVE??
'
'Then Reschedue myself:
Next1Min = Now + TimeSerial(0, 1, 2)
Debug.Print "Eseguo MacroOneMin", Now, Next1Min
Application.OnTime Next1Min, "OneMinuteMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro15Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime Next1Min, "OneMinuteMacro"
End If
If Next30Min < (Now - TimeSerial(0, 1, 0)) Then
Next30Min = Now + TimeSerial(0, 30, 0) '30
Application.OnTime Next30Min, "Macro30Min"
End If
'Reschedue myself:
Next15Min = Now + TimeSerial(0, 14, 0) '15
Debug.Print "Eseguo Macro15Min", Now, Next15Min
Application.OnTime Next15Min, "Macro15Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub Macro30Min() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next15Min < (Now - TimeSerial(0, 1, 0)) Then
Next15Min = Now + TimeSerial(0, 14, 0) '15
Application.OnTime Next15Min, "Macro15Min"
End If
If Next60Min < (Now - TimeSerial(0, 5, 0)) Then
Next60Min = Now + TimeSerial(0, 59, 0) '60
Application.OnTime Next60Min, "OneHourMacro"
End If
'Reschedue myself:
Next30Min = Now + TimeSerial(0, 30, 0)
Debug.Print "Eseguo Macro30Min", Now, Next30Min '30
Application.OnTime Next30Min, "Macro30Min"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Sub OneHourMacro() 'MACRO DI CONTROLLO
If StopAll = False Then
If Next30Min < (Now - TimeSerial(0, 5, 0)) Then
Next30Min = Now + TimeSerial(0, 30, 0) '30
Application.OnTime Next30Min, "Macro30Min"
End If
If Next1Min < (Now - TimeSerial(0, 0, 30)) Then
Next1Min = Now + TimeSerial(0, 1, 1)
Application.OnTime Next1Min, "OneMinuteMacro"
End If
'Reschedue myself:
Next60Min = Now + TimeSerial(0, 59, 0) '60
Debug.Print "Eseguo Macro60Min", Now, Next60Min
Application.OnTime Next60Min, "OneHourMacro"
Else
'Stop all schedules:
On Error Resume Next
Application.OnTime Next1Min, "OneMinuteMacro", , False
Application.OnTime Next15Min, "Macro15Min", , False
Application.OnTime Next30Min, "Macro30Min", , False
Application.OnTime Next60Min, "OneHourMacro", , False
On Error GoTo 0
End If
End Sub
Private Sub Workbook_Open()
Next1Min = Now + TimeSerial(0, 1, 2)
Application.OnTime NextOneMin, "OneMinuteMacro"
Next15Min = Now + TimeSerial(0, 14, 0)
Application.OnTime Next15Min, "Macro15Min"
Next30Min = Now + TimeSerial(0, 30, 0)
Application.OnTime Next30Min, "Macro30Min"
Next60Min = Now + TimeSerial(0, 59, 0)
Application.OnTime Next60Min, "OneHourMacro"
End Sub
Torna a Applicazioni Office Windows
Screenshot automatizzato fogli excel:script?macro o...? Autore: Paolo67met |
Forum: Programmazione Risposte: 9 |
Inserire in colonna dati presi da altra colonna Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Trasferimento dati tra due fogli con due condizioni Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 9 |
Equiparare il tatso + al tasto invio Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Gianca532011, raimea e 21 ospiti