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 16171819>
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: 24/Gen/2013 at 09:26
FUNZIONE 154 Oggetto CommonDialog
§cmdlg_file
Sub
FileCartelle
Luciano
§Naviga nel file System e alla scelta di un file immagine, ne assegna il percorso alla stringa che ritorna la funzione.§

 

 

 

 


§Public Function cmdlg_file() As String
   Dim OpenFile As OPENFILENAME
   Dim lReturn As Long
   Dim sFilter As String
   OpenFile.lStructSize = Len(OpenFile)
   sFilter = "Immagini (*.wmf,*.bmp,*.jpg,*.tif)" & Chr(0) & "*.wmf;*.bmp;*.jpg;*.tif" & Chr(0)
   OpenFile.hwndOwner = Application.hWndAccessApp
   OpenFile.lpstrFilter = sFilter
   OpenFile.nFilterIndex = 1
   OpenFile.lpstrFile = String(257, 0)
   OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
   OpenFile.lpstrFileTitle = OpenFile.lpstrFile
   OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   OpenFile.lpstrInitialDir = "Application.CurrentProject.Path"
   OpenFile.lpstrTitle = "Selezione"
   OpenFile.flags = 0
   lReturn = GetOpenFileName(OpenFile)
   If lReturn = 0 Then
      cmdlg_file = ""
      'DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70 'Se richiesto un undo nella maschera togliere il segno di spunta
   Else
      cmdlg_file = Left(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, Chr$(0)) - 1)
   End If
   msgbox cmdlg_file
'incollare nella dichiarazione di un modulo
'Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
'            Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'Public Type OPENFILENAME
'   lStructSize As Long
'   hwndOwner As Long
'   hInstance As Long
'   lpstrFilter As String
'   lpstrCustomFilter As String
'   nMaxCustFilter As Long
'   nFilterIndex As Long
'   lpstrFile As String
'   nMaxFile As Long
'   lpstrFileTitle As String
'   nMaxFileTitle As Long
'   lpstrInitialDir As String
'   lpstrTitle As String
'   flags As Long
'   nFileOffset As Integer
'   nFileExtension As Integer
'   lpstrDefExt As String
'   lCustData As Long
'   lpfnHook As Long
 '  lpTemplateName As String
'End Type
End Function§

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: 12/Feb/2013 at 13:21
FUNZIONE 155 Intervallo valori
§IntervalloValori
Funzione
Matematica
Luciano
§Determina a quale intervallo valori appartiene un numero.
tipologia intervalli 1 .. 10    11 .. 20   21 .. 30§
Numero
2

 

 

 


§Public Function IntervalloValori(Numero As Integer)
'tipologia intervalli 1 .. 10    11 .. 20   21 .. 30
Dim NumeroCopia, Segno   As Integer
Segno = Sgn(Numero)
Numero = Abs(Numero)
If Numero Mod 10 = 0 Then
    NumeroCopia = Abs(Numero) - 1
Else
    NumeroCopia = Abs(Numero)
End If
EstremoAlto = (Int(NumeroCopia \ 10) + 1) * 10
EstremoBasso = (Int(NumeroCopia \ 10)) * 10 + 1
IntervalloValori = Segno * EstremoBasso & " ... " & Segno * EstremoAlto
msgbox IntervalloValori
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: 12/Feb/2013 at 13:22
FUNZIONE 156 Intervallo valori (2)
§IntervalloValori_Bis
Funzione
Matematica
Luciano
§Determina a quale intervallo valori appartiene un numero.
tipologia intervalli 0 … 9    10 … 19   20 … 29§
Numero
-1

 

 

 


§Public Function IntervalloValori_Bis(Numero As Integer)
'tipologia intervalli 0 … 9    10 … 19   20 … 29
Dim NumeroCopia, Segno As Integer
Segno = IIf(Numero = 0, 1, Sgn(Numero))
Numero = Abs(Numero)
If Numero Mod 10 = 0 Then
    NumeroCopia = Abs(Numero) + 1
Else
   NumeroCopia = Abs(Numero)
End If
EstremoBasso = (Int(NumeroCopia \ 10)) * 10 + 1 - 1
EstremoAlto = (Int(NumeroCopia \ 10) + 1) * 10 - 1
IntervalloValori_Bis = Segno * EstremoBasso & " ... " & Segno * EstremoAlto
msgbox IntervalloValori_Bis
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: 12/Feb/2013 at 19:21

Funzione 157 Intervallo valori (3)

§IntervalloValori_ter
Funzione
Matematica
Luciano
§Determina a quale intervallo valori appartiene un numero.
tipologia intervalli -19 … -10    -9 … 0  0 … 9    10 … 19§
Numero
-10

 

 

 


§Public Function IntervalloValori_ter(Numero As Integer) As String
'tipologia intervalli -19 … -10    -9 … 0  0 … 9    10 … 19
Dim Avanti As Integer
Avanti = 1
If Numero >= 0 Then
    Do While (Avanti + Numero) Mod 10 <> 0
        Avanti = Avanti + 1
    Loop
    IntervalloValori_ter = (Avanti + Numero - 10) & " ... " & (Avanti + Numero - 1)
Else
Avanti = 10
    Do While (Numero - Avanti) Mod 10 <> 0
        Avanti = Avanti - 1
    Loop
    IntervalloValori_ter = (Numero - Avanti + 1) & " ... " & (Numero - Avanti + 10)
End If

msgbox IntervalloValori_ter
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: 14/Feb/2013 at 17:08
Funzione 158 Aggiorna collegamenti al BE
§AggiornaCollegamenti
Funzione
Tabella
VediCodice
§Collega le tabelle presenti nel BE spostato in altra cartella. Non funzionante nel contesto di questo db in quanto database non diviso.§
NomeDatabase
C:\Users\io\Desktop\Ial attuali\prova2.mdb
 
 
 

§Public Function AggiornaCollegamenti(NomeDatabase As String) As Boolean
'Modifica sul lavoro di  Federico Luciani http://www.ialweb.it/forum/forum_posts.asp?TID=16464306&PN=1&title=risoltoperdita-record-back-end-su-copia-del-db
    Dim dbs As Database
    Dim tdf As TableDef
    Set dbs = CurrentDb
    f_AggiornaColl = False
    For Each tdf In dbs.TableDefs
        If (Len(tdf.Connect) > 0) Then
            tdf.Connect = ";DATABASE=" & strMdb
            Err = 0
            On Error Resume Next
            tdf.RefreshLink
                Select Case Err.Number
                    Case 3024
                        msgbox "Impossibile trovare il file:" & vbCrLf & Mid$(tdf.Connect, 11), vbCritical + vbOKOnly, "Errore nel collegamento"
                        Exit Function
                    Case 0
                        msgbox tdf.Name & " Collegata a " & DLookup("Database", "MSysObjects", "Type=6")
                        f_AggiornaColl = True
                    Case Else
                        msgbox tdf.Name & vbCrLf & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Errore"
                End Select
        End If
    Next tdf
End Function§


Edited by Luciano - 14/Feb/2013 at 17:10
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/Feb/2013 at 19:36
Funzione 159 Immisione dati in Inputbox
§InputBox1
Sub
Form
Luciano
§Inserisce una stringa in una variabile per mezzo di una finestra di immissione dati§
Messaggio
Quanti euro hai in tasca?
Titolo
Inserimento dati
Predefinito
100
PosizioneX
4000
PosizioneY
5000
§Public Sub InputBox1(Messaggio As String, Titolo As String, predefinito As String, PosizioneX As Long, PosizioneY As Long)
Dim Response As String
On Error GoTo Err_Close   'Prima della riga in cui potrebbe verificarsi l'errore
Response = InputBox(Messaggio, Titolo, predefinito, PosizioneX, PosizioneY)
If Response = "" Then msgbox "Hai Annullato o hai premuto X": Exit Sub
msgbox "Hai immesso """ & Response & """"
Exit_here:
     Exit Sub
Err_Close:
If Err = 6 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: 16/Feb/2013 at 19:52

Funzione 160 Cambio Colore in casella

 
§ChangeBackColor
Sub
Form
Luciano
§Il cambio di colore. 15 colori codificati richiamabili dal parametro ColorCode; se ColorCode maggiore di 15 allora i parametri utili sono dettati da Red, Green, Blue§
ColorCode
15
Red
200
Green
200
Blue
200


§Public Sub ChangeBackColor(ColorCode As Integer, RED As Integer, Green As Integer, Blue As Integer)
If ColorCode <= 15 Then
    ColorCode = CInt(ColorCode)
    Forms!Menù.TCodice.BackColor = QBColor(ColorCode)
Else
    Forms!Menù.TCodice.BackColor = RGB(RED, Green, Blue)
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: 21/Feb/2013 at 17:09
Funzione 161 Restituisce il percorso della cartella selezionata
§SelezionaCartella
Funzione
FileCartelle
Luciano
§Restituisce il percorso di una cartella§
 
 
 
 

§Public Function SelezionaCartella()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
     With fd
             .Title = "seleziona cartella"
             .ButtonName = "Ok"
             .AllowMultiSelect = False
             .InitialView = msoFileDialogViewDetails
             .InitialFileName = Application.CurrentProject.Path
             .Show
             For Each objfl In .SelectedItems
                 FileName = objfl
             Next objfl
     End With
Set fd = Nothing
SelezionaCartella = FileName
msgbox SelezionaCartella
End Function§
 
modificata a seguito di segnalazione di errore (Mancava l'assegnazione e la parte finale)


Edited by Luciano - 03/Mar/2013 at 09:35
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: 28/Feb/2013 at 16:34

Funzione n. 162 Input Dati su Multi Riga

§InputDatiMultiRiga
Sub
Sql
willy
§Scrive su più righe il messaggio di una inputbox anche in quella di immissione dati delle query di access§
PrimaRiga
Inserire dato, questa è la prima riga
SecondaRiga
questa la seconda riga
TerzaRiga
questa la terza riga

 


§Public Function InputDatiMultiRiga(PrimaRiga As String, SecondaRiga As String, TerzaRiga As String) As String
    Dim strDato As String
    strDato = InputBox(PrimaRiga & Chr(13) & Chr(10) & _
        SecondaRiga & vbCrLf & _
        TerzaRiga, "Titolo")
    InputDatiMultiRiga = strDato
End Function§



Edited by Luciano - 03/Mar/2013 at 09:27
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: 15/Mar/2013 at 08:13

Funzione n. 163 Rinomina files

Questa funzione che ho attribuito ad Alex, è stata rimossa su  sua richiesta poichè nel comunicargli privatamente che l'avrei inserita nel catalogo giorno 11/03/2012 ho omesso di chiedergli il consenso alla pubblicazione.

 
ciao


Edited by Luciano - 18/Mar/2013 at 10:57
Dio è Amore e Pace
Catalogo funzioni
Back to Top
 Post Reply Post Reply Page  <1 16171819>
  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,047 seconds.