IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Access
  New Posts New Posts RSS Feed - Catalogo delle funzioni, articoli e risorse utili
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

Topic ClosedCatalogo delle funzioni, articoli e risorse utili

 Post Reply Post Reply Page  <1 1415161718 19>
Author
Message
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 14/Gen/2013 at 13:11

Funzione 0137 Metodo InsertLines dell'oggetto Modulo

§MetodoInsertLines
Sub
Moduli
Luciano
§Metodo InsertLines inserisce una riga o un gruppo di righe di codice in un modulo§
Stringa
UN SALUTO A TUTTO IL FORUM

 

 

 


§Public Sub MetodoInsertLines(Stringa As String)
'UN SALUTO A TUTTO IL FORUM
Dim mdl As Module
Dim RigaInizio As Long
Dim Risultato As Boolean
Set mdl = Modules("Mod_Funzioni")
'Ricerca la riga d'inizio di questa funzione, sotto la quale inserire la stringa,passando il paramentro vuoto RigaInizio
Risultato = mdl.Find("Public Sub MetodoInsertLines(Stringa As String)", RigaInizio, 0, 0, 0, False, False, False)
mdl.InsertLines RigaInizio + 1, "'" & Stringa
XXRichiamaFunzione

Set mdl = Nothing
End Sub§


Edited by Luciano - 15/Gen/2013 at 12:20
Dio è Amore e Pace
Catalogo funzioni
Back to Top
Sponsored Links


Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 14/Gen/2013 at 13:13
Funzione 0138 Metodo DeleteLines dell'oggetto Modulo
§MetodoDeleteLines
Sub
Moduli
Luciano
§Metodo DeleteLines elimina righe da un modulo§
Stringa
UN SALUTO A TUTTO IL FORUM

 

 

 


§Public Sub MetodoDeleteLines(Stringa As String)
'UN SALUTO A TUTTO IL FORUM
'UN SALUTO A TUTTO IL FORUM
'UN SALUTO A TUTTO IL FORUM
Dim mdl As Module
Dim RigaInizio As Long
Dim FunzioneTrovata, StringaTrovata As Boolean
Set mdl = Modules("Mod_Funzioni")
'Ricerca la riga d'inizio di questa funzione
FunzioneTrovata = mdl.Find("Public Sub MetodoDeleteLines(Stringa As String)", RigaInizio, 0, 0, 0, False, False, False)
StringaTrovata = mdl.Find(Stringa, RigaInizio, 0, 0, 0, False, False, False)
If StringaTrovata Then
    mdl.DeleteLines RigaInizio, 1
Else
    MsgBox "Testo non trovato"
End If
XXRichiamaFunzione

Set mdl = Nothing
End Sub§


Edited by Luciano - 15/Gen/2013 at 12:22
Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 14/Gen/2013 at 13:15
Funzione 0139 Metodo ReplaceLine dell'oggetto Modulo
§MetodoReplaceLine
Sub
Moduli
Luciano
§Metodo ReplaceLine sostituisce righe in un modulo§
VecchiaStringa
UN SALUTO A TUTTO IL FORUM
NuovaStringa
BUONANOTTE AI FORISTI

 

 


§Public Sub MetodoReplaceLine(VecchiaStringa As String, NuovaStringa As String)
'UN SALUTO A TUTTO IL FORUM
'UN SALUTO A TUTTO IL FORUM
'UN SALUTO A TUTTO IL FORUM
Dim mdl As Module
Dim RigaInizio As Long
Dim FunzioneTrovata, StringaTrovata As Boolean
Dim NomeFunzione As String
Dim InizioFunzione, NRigheFunzione As Long
Set mdl = Modules("Mod_Funzioni")
'Determina la riga (RigaInizio) dove si trova l'inizio di questa funzione
FunzioneTrovata = mdl.Find("Public Sub MetodoReplaceLine", RigaInizio, 0, 0, 0, False, False, False)
'---------------------------------------
'determina il nome della funzione, il n. della riga di inizio, la sua lunghezza, e quindi la sua ultima rigane
NomeFunzione = mdl.ProcOfLine(RigaInizio, vbext_pk_Proc)
InizioFunzione = mdl.ProcBodyLine(NomeFunzione, vbext_pk_Proc)
NRigheFunzione = mdl.ProcCountLines(NomeFunzione, vbext_pk_Proc)
'Nuova ricercaapartire dall'inizio di questa funzione
StringaTrovata = mdl.Find(VecchiaStringa, RigaInizio, 0, InizioFunzione + NRigheFunzione, 0, False, False, False)
If StringaTrovata Then
    mdl.ReplaceLine RigaInizio, "'" & NuovaStringa
Else
    MsgBox "Testo non trovato"
End If
XXRichiamaFunzione

Set mdl = Nothing
End Sub§


Edited by Luciano - 15/Gen/2013 at 12:21
Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 16/Gen/2013 at 12:14
Funzione 0140 Elenco di tutte le routine di un Modulo
§ElencoRoutine
Sub
Moduli
Luciano
§Ricava i nomi di tutte le routine presenti in un modulo, il loro numero, fraziona il messaggio poiché troppo lungo per l'oggetto msgbox.§
strModuleName
Mod_Funzioni

 

 

 


§Public Sub ElencoRoutine(ByVal strModuleName As String)
'Dalla guida di Office
    Dim mdl As Module
    Dim lngCount As Long
    Dim lngCountDecl As Long
    Dim lngI  As Long
    Dim strProcName As String
    Dim astrProcNames() As String
    Dim intI, i As Integer
    Dim strMsg As String
    Dim lngR As Long
    Dim Sinistra As String
    ' Open specified Module object.
    DoCmd.OpenModule strModuleName
    ' Return reference to Module object.
    Set mdl = Modules(strModuleName)
    ' Count lines in module.
    lngCount = mdl.CountOfLines
    ' Count lines in Declaration section in module.
    lngCountDecl = mdl.CountOfDeclarationLines
    ' Determine name of first procedure.
    strProcName = mdl.ProcOfLine(lngCountDecl + 1, lngR)
    ' Initialize counter variable.
    intI = 0
    ' Redimension array.
    ReDim Preserve astrProcNames(intI)
    ' Store name of first procedure in array.
    astrProcNames(intI) = strProcName
    ' Determine procedure name for each line after declarations.
    For lngI = lngCountDecl + 1 To lngCount
        ' Compare procedure name with ProcOfLine property value.
        If strProcName <> mdl.ProcOfLine(lngI, lngR) Then
            ' Increment counter.
            intI = intI + 1
            strProcName = mdl.ProcOfLine(lngI, lngR)
            ReDim Preserve astrProcNames(intI)
            ' Assign unique procedure names to array.
            astrProcNames(intI) = strProcName
        End If
    Next lngI
   
    strMsg = "Procedures in module '" & strModuleName & "': " & vbCrLf & vbCrLf
    For intI = 0 To UBound(astrProcNames)
        strMsg = strMsg & astrProcNames(intI) & "; "
    Next intI
   
    ' Message box listing all procedures in module.
    'questa porzione di codice serve a frazionare il messaggio in uscita se troppo lungo per essere visualizzato in un unico messaggio
 If Len(strMsg) > 1023 Then
      While Len(strMsg) > 1023
        Sinistra = Left(strMsg, 1023)
        For i = 1023 To 1 Step -1
            If Mid(Sinistra, i, 1) = " " Then
                Sinistra = Left(Sinistra, i)
                Exit For
            End If
        Next i
        strMsg = Right(strMsg, Len(strMsg) - i)
        msgbox Sinistra
      Wend
 End If
 If Len(strMsg) > 0 Then msgbox strMsg
msgbox "Il modulo è composto da: " & intI & " funzioni; "
Set mdl = Nothing
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 17/Gen/2013 at 11:20
Funzione 0141 Proprietà dell'oggetto Err
 
§GestioneErrore
Sub
Varie
Luciano
§Riproduce un errore e restituisce un messaggio descrittivo§
NumeroErrore
11

 

 

 


§Public Sub GestioneErrore(NumeroErrore As Long)
'Dalla guida in linea
'Non dichiarare l'oggetto Err
Dim Msg As String
' Se si verifica un errore, crea un messaggio di errore
On Error Resume Next   ' Rimanda la gestione dell'errore [reimposta Err]
Err.Clear
Err.Raise NumeroErrore 'genera un errore di run-time nel codice
' Verifica la presenza dell'errore, quindi visualizza il messaggio.
If Err.Number <> 0 Then
    Msg = "Errore " & Str(Err.Number) & " generato da " _
            & Err.Source & Chr(13) & Err.Description
    msgbox Msg, , "Errore", Err.HelpFile, Err.HelpContext
 'Str(Err.Number) Err.Description Err.Source Err.HelpFile Err.HelpContext
End If
'La proprietà predefinita dell'oggetto Err è Number.
'Err.Clear[reimposta Err in modo esplicito]
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 17/Gen/2013 at 15:35
Funzione 0142 Schema Gestione ERRORE
§SchemaGestioneERRORE
Sub
Varie
Luciano
§Schema da inserire nelle funzioni per la gestione degli errori§

 

 

 

 


§Public Sub SchemaGestioneERRORE()
Dim Risultato As Integer
On Error GoTo Err_Close   'Prima della riga in cui potrebbe verificarsi l'errore
    Risultato = 4 / 0
Exit_here:
     Exit Sub
Err_Close:
If Err = 11 Then
   msgbox "Errore " & Str(Err.Number) & " generato da " & Err.Source & Chr(13) & Err.Description
   Resume Exit_here
End If
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 17/Gen/2013 at 15:41
Funzione 143 Struttura If e Iif nidificate
§IifNidificata
Sub
Varie
Luciano
§Confronto fra la struttura If e quella Iif nidificate.§
Maschera1
true
Maschera2
true
Parametro1
10
Parametro2
20


§Public Sub IifNidificata(Maschera1 As Boolean, Maschera2 As Boolean, Parametro1 As Long, Parametro2 As Long)
Dim StrSql, StrSql2 As String
If Maschera1 Then
    StrSql = "select * from miatabella where campoId=" & Parametro1 & " and campox=1;"
ElseIf Maschera2 Then
        StrSql = "select * from miatabella where campoId=" & Parametro2 & " and campox=1;"
    Else
        StrSql = "select * from miatabella where campox=1;"
End If
StrSql2 = IIf(Maschera1, "select * from miatabella where campoId=" & Parametro1 & " and campox=1;", IIf(Maschera2, "select * from miatabella where campoId=" & Parametro2 & " and campox=1;", "select * from miatabella where campox=1;"))
msgbox StrSql & vbCrLf & StrSql2
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 17/Gen/2013 at 15:45
Funzione 144 Esporta tabella in excel
§ExportToExcel
Sub
Excel
Luciano
§Esporta una tabella in un file excel. Rinomina il file  posponendo la data odierna.§
Tabella1
categorie
NomeFile
TabellaCategoria

 

 


§Public Sub ExportToExcel(Tabella, NomeFile)
On Error GoTo Err_Close
    DoCmd.TransferSpreadsheet transfertype:=acExport, _
      spreadsheettype:=acSpreadsheetTypeExcel9, _
      tablename:="" & Tabella & "", _
      FileName:=Application.CurrentProject.Path & "\" & NomeFile & ".xls", _
      hasfieldnames:=True
      Name Application.CurrentProject.Path & "\" & NomeFile & ".xls" As Application.CurrentProject.Path & "\" & NomeFile & "" & Day(Date) & Month(Date) & Year(Date) & ".xls"
msgbox "Fatto"
Exit_here:
     Exit Sub
Err_Close:
   msgbox "Errore " & Str(Err.Number) & Chr(13) & Err.Description
   Resume Exit_here
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 17/Gen/2013 at 15:58
Funzione 145 Aggiunge foglio ad excel
§AggiungiFoglioExcel
Sub
Excel
VediCodice
§Aggiunge un foglio ad un file excel   http://microsoft.public.it.office.access.narkive.com/fW3BZ0Nu/automazione-excel§
NomeFileExcel
nomefile732012
NomeFoglio
NuovoFoglio

 

 


§Public Sub AggiungiFoglioExcel(NomeFileExcel, NomeFoglio)
Dim Xlsapp As Object
On Error GoTo Err_Close
    Dim strProgetto As String
    Dim NewSh As Object
    strProgetto = Application.CurrentProject.Path & "\" & NomeFileExcel & ".xls"
    Set Xlsapp = CreateObject("Excel.Application")
    Xlsapp.Workbooks.Open strProgetto
    Set NewSh = Xlsapp.Worksheets.Add
    NewSh.Name = NomeFoglio
    Xlsapp.Workbooks(1).Save
    Xlsapp.Quit
    Set Xlsapp = Nothing
Exit_here:
     Exit Sub
Err_Close:
   msgbox "Errore " & Str(Err.Number) & Chr(13) & Err.Description
   Resume Exit_here
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 2121
Direct Link To This Post Posted: 18/Gen/2013 at 08:55
Funzione 146 Genera un Calendario
§GeneraCalendario
Sub
Tabella
Luciano
§Genera tanti record quanti i giorni che intercorrono fra due date§
GiornoInizio
01/01/2012
GiornoFine
31/12/2012
Tabella
Tabella2

 


§Public Sub GeneraCalendario(GiornoInizio As Date, GiornoFine As Date, Tabella As String)
'Richiesta una tabella(Tabella2) con un campo Data di tipo Date
Dim Giorno As Date
Dim Giorni, x As Integer
DoCmd.SetWarnings False
Giorno = GiornoInizio
Giorni = DateDiff("d", GiornoInizio, GiornoFine) + 1
For x = 1 To Giorni
    DoCmd.RunSQL "insert into " & Tabella & " (Data) values(#" & Format(Giorno, "mm/dd/yy") & "#)" 'se la chiave primaria è un contatore
    'DoCmd.RunSQL "insert into " & Tabella & " (Id, Data) values(" & x & ",#" & Format(Giorno, "mm/dd/yy") & "#)" Se il campo id è un numerico
    Giorno = Giorno + 1
Next x
DoCmd.SetWarnings True
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
 Post Reply Post Reply Page  <1 1415161718 19>
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,063 seconds.