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 1314151617 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: 07/Gen/2013 at 09:38

Funzione 0127 Inserisce una funzione nel modulo

§InserisciCodice
Sub
Moduli
Luciano
§Inserisce una funzione nel modulo Tramite la casella di testo. Tipo richiede Function o Sub§
NomeModulo
Mod_Funzioni
NomeFunzione
hhtt
Tipo
Sub
IdCategoria
3


§Public Sub InserisciCodice(NomeModulo, NomeFunzione, Tipo, IdCategoria)
Dim mdl As Module
Dim Inizio, IdPrecedente As Integer
Dim Blocco As String
If Not CurrentProject.AllModules(NomeModulo).IsLoaded Then DoCmd.OpenModule NomeModulo
Set mdl = Modules(NomeModulo)
On Error Resume Next ''''''
Blocco = "Public " & Tipo & "  " & NomeFunzione & vbCrLf & vbCrLf & "End " & Tipo
Inizio = TrovaInizioFunzione(NomeModulo, NomeFunzione)
If Inizio = 0 Then
    mdl.InsertText (Blocco)
    mdl.DeleteLines mdl.ProcCountLines(NomeModulo, vbext_pk_Proc), 1
    MsgBox "Inserito Codice"
    DoCmd.SetWarnings False
    DoCmd.RunSQL "INSERT INTO Funzioni ( Funzione, IdCategoria ) values('" & NomeFunzione & "' , " & IdCategoria & ") ;"
    DoCmd.SetWarnings True
    Forms!Menù.Requery
    XXVaiUltimo
Else
    MsgBox " Esiste già una funzione di nome """ & NomeFunzione & """"
End If
DoCmd.Close acModule, NomeModulo, acSaveYes
Forms!Menù.FIltroFunzione.Requery
Set mdl = Nothing
End Sub§

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: 07/Gen/2013 at 09:40

Funzione 0128 Trova Inizio Funzione

§TrovaInizioFunzione
Funzione
Moduli
Luciano
§Funzione di appoggio alle altre funzioni di sistema per trovare le singole funzioni§
NomeModulo
Mod_Funzioni
Funz
ModificaFunzione

 

 


§Public Function TrovaInizioFunzione(NomeModulo, Funz) As Integer
Dim mdl As Module
Set mdl = Modules(NomeModulo)
On Error Resume Next
TrovaInizioFunzione = mdl.ProcStartLine(Funz, vbext_pk_Proc) 'Restituisce l'inizio riga della funzione in argomento
If TrovaInizioFunzione > 0 Then MsgBox "Trovato alla riga " & TrovaInizioFunzione & " del modulo " & NomeModulo
End Function§

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: 07/Gen/2013 at 09:43

Funzione 0129 Elimina una Funzione dal modulo

§EliminaFunzione
Sub
Moduli
Luciano
§Elimina  funzione e codice.§
NomeModulo
Mod_Funzioni
NomeFunzione
hhtt

 

 


§Public Sub EliminaFunzione(NomeModulo, NomeFunzione)
Dim mdl As Module
Dim Inizio, Lunghezza, IdPrecedente As Integer
If Not CurrentProject.AllModules(NomeModulo).IsLoaded Then DoCmd.OpenModule NomeModulo
Set mdl = Modules(NomeModulo)
Inizio = TrovaInizioFunzione(NomeModulo, NomeFunzione)
If Inizio = 0 Then 'non esiste codice
        If IsNull(DLookup("Funzione", "Funzioni", "Funzione = """ & NomeFunzione & """")) Then  '4 Non esiste nella tabella non esiste codice
            MsgBox "Non esiste codice nel vba  nè record nella tabella Funzioni inerente """ & NomeFunzione & """": Exit Sub
         Else
            MsgBox "Non trovato codice nel vba, eliminato record nella tabella Funzioni":
            GoTo 5000 '2 esiste nella tabella non esiste codice
         End If
Else ' esiste codice
    Lunghezza = mdl.ProcCountLines(NomeFunzione, vbext_pk_Proc)
    mdl.DeleteLines Inizio, Lunghezza
    DoCmd.SelectObject acForm, "Menù", False
    DoCmd.Close acModule, NomeModulo, acSaveYes
        If IsNull(DLookup("Funzione", "Funzioni", "Funzione = """ & NomeFunzione & """")) Then '3 Non esiste nella tabella  esiste codice
            MsgBox "Eliminato codice nel vba; non esiste record nella tabella Funzioni inerente """ & NomeFunzione & """": Exit Sub
         Else ' 1 esiste nella tabella  esiste codice
            MsgBox "Eliminato sia il codice nel vba che  record nella tabella Funzioni inerente """ & NomeFunzione & """"
            GoTo 5000
         End If
End If
'Forms!Menù.Recordset.Delete 'Togliere il commento se si vuole cancellare il record corrente, nel caso di funzione di sistema
5000
DoCmd.SetWarnings False
IdPrecedente = Forms!Menù.TId.Value '1
DoCmd.RunSQL "Delete from Funzioni where funzione= """ & NomeFunzione & """"
Forms!Menù.Requery
Forms!Menù.TId.SetFocus  'Aspetta di trovare la chiave primaria prima di Requery
DoCmd.SelectObject acForm, "mENù", False:
DoCmd.FindRecord IdPrecedente
DoCmd.SetWarnings True
DoCmd.Close acModule, NomeModulo, acSaveYes
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: 10/Gen/2013 at 09:24
Funzione 0130 Azzeratore tabella con Dao
§AzzeraContatoreDao
Funzione
Tabella
VediCodice
§Azzeratore di una tabella con gestione di errori con accesso ai dati Dao.  ' Tratto da demo nr. 19  dal sito: http://www.infogreg.it/riservato/ialweb.asp§
strNomeTabella
tabella1
strNomeCampoCounter
id

 

 


§Public Function AzzeraContatoreDao(strNomeTabella As String, _
                                strNomeCampoCounter As String) As Boolean
' --------------------------------------------------
' La funzione azzera una singola tabella e
' il suo relativo contatore senza la necessità
' di compattare il database
' --------------------------------------------------
' La funzione riceve due parametri
' - nome della tabella (stringa)
' - nome del campo contatore nella tabella (stringa)
' Restituisce un valore booleano per l'esito delle operazioni
' (con True = OK altrimenti False)
'
' Le operazioni effettuate sono:
' Cancella tutti i record (uno alla volta)
' Azzera il contatore
' Assegna zero al contatore
' Assegna ed elimina il record transitorio
' Tratto da demo nr. 19
' (Demo per azzerare un contatore di una tabella senza compattare Demo per azzerare un contatore di una tabella senza compattare)
' dal sito:
' http://www.infogreg.it/riservato/ialweb.asp
' --------------------------------------------------
Dim rst As DAO.Recordset
Dim strCriterio As String
Dim myOk As Boolean
 
On Error GoTo Err_AzzeraContatoreSingolaTabellaDao
myOk = False ' Valore di ritorno
strCriterio = "SELECT * FROM " & strNomeTabella & ";"
' tabellaconcontatore"
Set rst = CurrentDb.OpenRecordset(strCriterio, dbOpenDynaset)
' Cancella TUTTI i records presenti
' Come Db.Execute "DELETE * FROM " & strNomeTabella & ";"
If Not rst.EOF Then
    rst.MoveFirst
    Do Until rst.EOF
        rst.Edit
        rst.Delete
        rst.MoveNext
    Loop
End If
' Azzera il contatore creando un record transitorio
' Come: Db.Execute "ALTER TABLE " & strNomeTabella & " ALTER COLUMN ID COUNTER(1,1);"
rst.AddNew
' rst!ID = 0
rst.Fields(strNomeCampoCounter) = 0
rst.Update
' Elimina il record transitorio
rst.MoveFirst
Do Until rst.EOF
    rst.Edit
    rst.Delete
    rst.MoveNext
Loop
 
rst.Close
  
Set rst = Nothing
myOk = True ' Valore di ritorno (operazioni concluse positivamente)
MsgBox "Fatto"
Exit_AzzeraContatoreSingolaTabellaDao:
    AzzeraContatoreSingolaTabellaDao = myOk ' Imposta valore ritorno a funzione
    Exit Function
Err_AzzeraContatoreSingolaTabellaDao:
    MsgBox Err.Description
    Resume Exit_AzzeraContatoreSingolaTabellaDao
   
End Function§

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: 10/Gen/2013 at 09:25
Funzione 0131 Azzeratore tabella con Dao(2)
§AzzeraContatore2Dao
Sub
Tabella
Luciano
§Azzeratore di una tabella essenziale con accesso ai dati Dao.§
Tabella
Tabella1

 

 

 


§Public Sub AzzeraContatore2Dao(Tabella)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(Tabella)
With rs
        .AddNew
        .Fields(0) = 0
        .Update
        rs.MoveFirst
    Do Until rs.EOF
        rs.Edit
        rs.Delete
        rs.MoveNext
    Loop
    .Close
    Set rs = Nothing
End With
MsgBox "Fatto"
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: 10/Gen/2013 at 09:28
Funzione 0132 Funzione Val
§FunzioneVal
Funzione
Matematica
VediCodice
§Restituisce i numeri inclusi in una stringa sotto forma di valore numerico del tipo appropriato.
La funzione Val interrompe la lettura della stringa in corrispondenza del primo carattere non riconosciuto come parte di un numero. I simboli e i caratteri che vengono spesso riconosciuti come parte di un valore numerico, come il segno di valuta e le virgole, non vengono riconosciuti. La funzione riconosce tuttavia i prefissi di radice &O per la rappresentazione ottale e &H per quella esadecimale. Gli spazi, le tabulazioni e i caratteri di avanzamento riga vengono eliminati dall'argomento§
Valore
 3 94.454 jiu

 

 

 


§Public Function FunzioneVal(Valore As String) As Single
'http://office.microsoft.com/it-it/access-help/funzione-val-HA001228931.aspx?CTT=5&origin=HA010131676
FunzioneVal = Val(Valore)
MsgBox FunzioneVal
End Function§

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: 10/Gen/2013 at 09:32
Funzione 0133 Rileva valori in un db remoto
§RilevaValoriSuDBRemoto
Sub
Form
VediCodice
§Rileva se una maschera in un db remoto è aperta§
Database
C:\Users\io\Desktop\Esempio.mdb
Maschera
Maschera1

 

 


§Public Sub RilevaValoriSuDBRemoto(Database As String, Maschera As String)
'http://answers.microsoft.com/it-it/office/forum/office_2003-access/rilevare-maschera-aperta-su-db-esterno/b6ece75e-b2a5-4c75-906d-b4d32b1d7b62?msgId=f7f67535-4826-49b5-94c8-6eba72929377
Dim objAccess As Object
    Set objAccess = GetObject(Database)
    MsgBox objAccess.CurrentProject.AllForms(Maschera).IsLoaded
         'Rileva se la maschera del DB Remoto è aperta
    MsgBox objAccess.CurrentProject.AllForms(Maschera).DateCreated
         'Rileva la data di creazione della maschera nel DB Remoto
    Set objAccess = 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: 10/Gen/2013 at 09:37
Funzione 0134 Rileva lo stato di un file
§FileStatus
Funzione
FileCartelle
VediCodice
§Verifica l'esistenza di un file in un determinato percorso, se esiste restituisce Chiuso o  Bloccato.§
strFileName
C:\Users\io\Desktop\varie.xls

 

 

 


§Public Function FileStatus(strFileName As String) As String
'http://answers.microsoft.com/it-it/profile/640f5107-a931-45ce-aed0-39ed27d1140a

'http://www.ialweb.it/forum/forum_posts.asp?TID=14402400&PID=3361394&title=catalogo-delle-funzioni-articoli-e-risorse-utili#3361394
  On Error GoTo ErrHandler
  Dim nFileNum As Integer
  nFileNum = FreeFile()
  Open strFileName For Input Access Read Lock Read As #nFileNum
ErrHandler:
  Select Case Err.Number
    Case 0
      FileStatus = "Closed"
      Close #nFileNum
    Case 53
      FileStatus = "NotFound"
      Err.Clear
    Case Else
      FileStatus = "Locked"
      Err.Clear
  End Select
MsgBox FileStatus
End Function§


Edited by Luciano - 16/Feb/2013 at 17:39
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: 12/Gen/2013 at 10:40
Funzione 0135 Fraziona un msgbox
 
§MsgboxFrazioni
Sub
Testo
Luciano
§Fraziona un msgbox in parti di 1023 caratteri§
Testo
Il testo troppo lungo per essere inserito qui

 

 

 


§Public Sub MsgboxFrazioni(Testo)
Dim Sinistra As String
Testo = "1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 1234567890 12345678 1234567890 1234567890 1234567890 " & _
"1234567890 1234567890 1234567890 1234"
'La larghezza massima nel msgbox di access è 71 caratteri, la lunghezza massima è 1023 caratteri
 If Len(Testo) > 1023 Then
      While Len(Testo) > 1023
        Sinistra = Left(Testo, 1023)
        For I = 1023 To 1 Step -1
            If Mid(Sinistra, I, 1) = " " Then
                Sinistra = Left(Sinistra, I)
                Exit For
            End If
        Next I
        Testo = Right(Testo, Len(Testo) - I)
        MsgBox Sinistra
      Wend
 End If
 If Len(Testo) > 0 Then MsgBox Testo
End Sub§



Edited by Luciano - 12/Gen/2013 at 10:41
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:10
Funzione 0136 Metodo Find dell'oggetto Modulo
 
§MetodoFind
Sub
Moduli
Luciano
§Trova il testo specificato in un modulo§
Destinazione
Altri parametri non passabili dalla form
RigaInizio
1
ColonnaInizio
1
RigaFine
5000
ColonnaFine
1023
§Public Sub MetodoFind(Destinazione As String, RigaInizio As Long, ColonnaInizio As Long, RigaFine As Long, ColonnaFine As Long)
Dim mdl As Module
Dim Risultato As Boolean
'Altri parametri non passabili dalla form poiché le righe di Parametri sono solo cinque
Dim ParolaIntera, Maiuscole, Criteri As Boolean
Set mdl = Modules("Mod_Funzioni")
ParolaIntera = False: Maiuscole = False: Criteri = False
'Il metodo Find ricerca la stringa di testo specificata in un oggetto Module. Se la stringa viene trovata, il metodo Find restituisce True.
If mdl.Find(Destinazione, RigaInizio, ColonnaInizio, RigaFine, ColonnaFine, ParolaIntera, Maiuscole, Criteri) Then
    'Per determinare all'interno del modulo la posizione in cui è stato trovato il testo di ricerca, passare variabili vuote
    'al metodo Find per gli argomenti RigaInizio, ColonnaInizio, RigaFine e ColonnaFine.
    'i Valori non congruenti vengono ignorati per esempio RigaFine minore di RigaInizio
    RigaInizio = 0: ColonnaInizio = 0: RigaFine = 0: ColonnaFine = 0:
    Risultato = mdl.Find(Destinazione, RigaInizio, ColonnaInizio, RigaFine, ColonnaFine, ParolaIntera, Maiuscole, Criteri)
    MsgBox " Testo trovato Alla riga " & RigaInizio & " Dal carattere " & ColonnaInizio & " fino carattere " & ColonnaFine & " della riga " & RigaFine
Else
    MsgBox "Testo non trovato"
End If
Set mdl = Nothing
End Sub§


Edited by Luciano - 15/Gen/2013 at 12:19
Dio è Amore e Pace
Catalogo funzioni
Back to Top
 Post Reply Post Reply Page  <1 1314151617 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,049 seconds.