§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§

§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§

§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§