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

 Topic   Topic Hot   Topic New   Topic Locked   Topic Sticky   Topic Hidden

Topic ClosedCatalogo delle funzioni, articoli e risorse utili
 Post Reply Post Reply Page  <1 1112131415 19>
Author
Message
  Topic Search Topic Search  Topic Options Topic Options
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 1972 		Direct Link To This Post Posted: 17/Apr/2012 at 11:40

Ridimensionare maschere adattandola alla risoluzione dello schermo.

Questa che propongo non è una demo nè una soluzione al problema di adattare le maschera alla diversa risoluzione dello schermo del pc in cui viene eseguita l'applicazione.
La definerei uno "STUDIO" che può essere ripreso dal programmatore di buona volontà per trovare una soluzione definitiva, semmai fosse possibile.
La maschera in avvio legge la risoluzione e adatta la larghezza. l'altezza, la distanza dall'alto, la distanza da sinistra e la grandezza del font dei diversi controlli.
Ho creato e adattato una maschera alla risoluzione  di 1280X800  e provato il risultato per risoluzioni intermedie fino a 800X600 con risultati discreti.
Il codice è stato creato partendo dall'ipotesi che esiste un rapporto fra la risoluzione di creazione o meglio l'altezza e la larghezza dello schermo e la nuova risoluzione.
Ove ciò non bastava ho usato il metodo  empirico per costringere il risultato alla bisogna.
Non ho provato tutti gli oggetti ma solo i più usati.
Il punto debole si ha con le immagini che non vengono ridimensionate.
Ciao
 
p.s.
l'argomento è stato in seguito sviscerato da Alex nel seguente 3d:
in cui l'ultima versione della demo è questa:


Edited by Luciano - 09/Feb/2013 at 19:26
Dio è Amore e Pace
Catalogo funzioni
Back to Top
Goemon View Drop Down
Utente Base
Utente Base
Avatar

Joined: 30/Lug/2011
Status: Offline
Points: 63 		Direct Link To This Post Posted: 04/Mag/2012 at 13:22
Funzione 0109 - Verificare se un file è aperto o chiuso
 
La funzione non può essere applicata a tutti i tipi di file... per esempio non funziona con i TXT e i JPG.
La funzione è stata creata a partire da questa discussione.
Function FileStatus(strFileName As String) As String
  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
End Function
Back to Top
Luciano View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 05/Giu/2010
Location: Italy
Status: Offline
Points: 1972 		Direct Link To This Post Posted: 31/Mag/2012 at 15:26
Funzione 0110  Elenco delle sottomaschere presenti
§LeggiSottomaschere
Sub
Form
Luciano
§Per la maschera in argomento cicla le sottomaschere e ricorsivamente  le di loro sottomaschere fino ad esaurimento.
L'elenco dato è in ordine di livello: il primo elemento  la maschera in argomento.
Nel database non ci sono sottomaschera; per cui testare con una maschera apposita.§
NomeMaschera
Masch_Categorie

 


 


 



§Public Sub LeggiSottomaschere(NomeMaschera)
Dim Matrice(20) As String
Dim cCont As Control
Dim Trovato As Boolean
Dim Stringa As String
Dim i, NumeroComplessivoMaschere, ProssimaMaschera, ContaMaschere As Byte
Trovato = False
ProssimaMaschera = 1
Matrice(1) = NomeMaschera
NumeroComplessivoMaschere = 1: ContaMaschere = 0
Ricomincia:
DoCmd.OpenForm Matrice(ProssimaMaschera)
 For Each cCont In Forms(Matrice(ProssimaMaschera)).Controls
    With cCont
        If .ControlType = acSubform Then
            Trovato = True
            ContaMaschere = ContaMaschere + 1
            NumeroComplessivoMaschere = NumeroComplessivoMaschere + 1
            Matrice(NumeroComplessivoMaschere) = cCont.SourceObject
        End If
    End With
Next cCont
If Trovato Then Trovato = False: ProssimaMaschera = ProssimaMaschera + 1:  ContaMaschere = 0: GoTo Ricomincia
For i = 1 To NumeroComplessivoMaschere
 Stringa = Stringa & Matrice(i) & vbCrLf
 DoCmd.Close acForm, Matrice(i)
Next i
MsgBox "La maschera " & Matrice(1) & " ha " & NumeroComplessivoMaschere & " maschere " & Stringa
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: 1972 		Direct Link To This Post Posted: 01/Ago/2012 at 13:24
Funzione 0111  Confronto fra due tabelle
§ConfrontaTabella
Sub
Tabella
Luciano
§Confronta due tabelle con nomi campo uguali e join fra  chiave esterna e   chiave primaria§
TabellaPrimaria
Tabella10
VecchiValori
Tabella11

 


 



§Public Sub ConfrontaTabella(TabellaPrimaria, VecchiValori)
Dim rs As New ADODB.Recordset
Dim fld As ADODB.Field
Dim rst1 As ADODB.Recordset
Set rst1 = New ADODB.Recordset
rs.Open "select * from  " & TabellaPrimaria & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set flds = rs.Fields
For Each fld In flds
        TabellaPrimariaNomeCampo = TabellaPrimaria & "." & fld.Name
        VecchiValoriNomeCampo = VecchiValori & "." & fld.Name
        ChiaveEsterna = VecchiValori & ".ChiaveEsterna"
        ChiavePrimaria1 = TabellaPrimaria & ".Id"
        rst1.Open "SELECT  " & ChiavePrimaria1 & "," & VecchiValoriNomeCampo & " FROM " & VecchiValori & " INNER JOIN " & TabellaPrimaria & " ON " & ChiaveEsterna & " = " & ChiavePrimaria1 & " WHERE (((" & VecchiValoriNomeCampo & ")<>[" & TabellaPrimariaNomeCampo & "]));", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
            While Not rst1.EOF
                If fld.Type <> 3 Then
                    MsgBox "Il record " & rst1.Fields(0).Value & "è stato modificato! " & vbCrLf & "Il valore precedente era """ & rst1.Fields(1).Value & """"
                End If
             rst1.MoveNext
                
            Wend
        rst1.Close
Next
rs.Close
Set rs = Nothing
Set rst1 = Nothing
End Sub§


Edited by Luciano - 02/Ago/2012 at 12:02
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: 1972 		Direct Link To This Post Posted: 30/Ott/2012 at 10:24
Funzione 0112  formato di data o di ora 
§FormatoData
Funzione
Data e ora
Luciano
§Restituisce un formato di data o di ora FormatDateTime(Data[,FormatoSpecifico])
Il primo parametro è il valore da elaborare il secondo il formato restituito: "vbGeneralDate 0, vbLongDate 1, vbShortDate 2, vbLongTime 3,  vbShortTime 4"§
Data1
11 /11/ 11 12:12
Data2
12:12
Data3
11 11
Data4
11 11 11


§Public Function FormatoData(Data1, Data2, Data3, Data4)


MsgBox "vbGeneralDate 0" & vbCrLf & "Viene visualizzata una data e/o un'ora. Se si include la parte della data, la data verrà visualizzata in formato breve." & _
"Se si include la parte dell'ora, l'ora verrà visualizzata in formato esteso. Se entrambe le parti vengono specificate, verrà visualizzata sia la data " & _
"che l'ora. " & vbCrLf & vbCrLf & "vbLongDate 1" & vbCrLf & "Visualizza la data nel formato esteso specificato nelle impostazioni internazionali del sistema." & _
"" & vbCrLf & vbCrLf & "vbShortDate 2 " & vbCrLf & "Visualizza la data nel formato breve specificato nelle impostazioni internazionali del sistema." & _
"" & vbCrLf & vbCrLf & "vbLongTime 3" & vbCrLf & "Visualizza l'ora nel formato specificato nelle impostazioni internazionali del sistema." & _
"" & vbCrLf & vbCrLf & "vbShortTime 4" & vbCrLf & " Visualizza l'ora nel formato a 24 ore (hh:mm)."


MsgBox "Interpretazione di Data1" & vbCrLf & vbCrLf & "vbGeneralDate: " & vbCrLf & FormatDateTime(Data1, vbGeneralDate) & vbCrLf & vbCrLf & "vbLongDate:" & _
"" & vbCrLf & FormatDateTime(Data1, vbLongDate) & vbCrLf & vbCrLf & "vbShortDate: " & vbCrLf & FormatDateTime(Data1, vbShortDate) & vbCrLf & vbCrLf & "vbLongTime:" & _
"" & vbCrLf & FormatDateTime(Data1, vbLongTime) & vbCrLf & vbCrLf & "vbShortTime: " & vbCrLf & FormatDateTime(Data1, vbShortTime)
MsgBox "Interpretazione di Data2" & vbCrLf & vbCrLf & "vbGeneralDate: " & vbCrLf & FormatDateTime(Data2, vbGeneralDate) & vbCrLf & vbCrLf & "vbLongDate:" & _
"" & vbCrLf & FormatDateTime(Data2, vbLongDate) & vbCrLf & vbCrLf & "vbShortDate: " & vbCrLf & FormatDateTime(Data2, vbShortDate) & vbCrLf & vbCrLf & "vbLongTime:" & _
"" & vbCrLf & FormatDateTime(Data2, vbLongTime) & vbCrLf & vbCrLf & "vbShortTime: " & vbCrLf & FormatDateTime(Data2, vbShortTime)
MsgBox "Interpretazione di Data3" & vbCrLf & vbCrLf & "vbGeneralDate: " & vbCrLf & FormatDateTime(Data3, vbGeneralDate) & vbCrLf & vbCrLf & "vbLongDate:" & _
"" & vbCrLf & FormatDateTime(Data3, vbLongDate) & vbCrLf & vbCrLf & "vbShortDate: " & vbCrLf & FormatDateTime(Data3, vbShortDate) & vbCrLf & vbCrLf & "vbLongTime:" & _
"" & vbCrLf & FormatDateTime(Data3, vbLongTime) & vbCrLf & vbCrLf & "vbShortTime: " & vbCrLf & FormatDateTime(Data3, vbShortTime)
MsgBox "Interpretazione di Data4" & vbCrLf & vbCrLf & "vbGeneralDate: " & vbCrLf & FormatDateTime(Data4, vbGeneralDate) & vbCrLf & vbCrLf & "vbLongDate: " & _
"" & vbCrLf & FormatDateTime(Data4, vbLongDate) & vbCrLf & vbCrLf & "vbShortDate: " & vbCrLf & FormatDateTime(Data4, vbShortDate) & vbCrLf & vbCrLf & "vbLongTime:" & _
"" & vbCrLf & FormatDateTime(Data4, vbLongTime) & vbCrLf & vbCrLf & "vbShortTime: " & vbCrLf & FormatDateTime(Data4, vbShortTime)


End Function§


Edited by Luciano - 31/Ott/2012 at 09:40
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: 1972 		Direct Link To This Post Posted: 07/Nov/2012 at 11:02
Funzione 0113  Alcune proprietà del Disk
§DiskProperty
Sub
Varie
Luciano
§Alcune proprietà del Disk
http://www.ialweb.it/forum/forum_posts.asp?TID=16463825&KW=partition&PID=3362791&title=risolto-propriet-delle-unit-di-memoria-wmi#3362791§
DriveLetter
C:

 


 


 



§Public Sub DiskProperty(ByVal DriveLetter As String)
  Dim WMI As Object
  Dim DSK As Object
  Dim Trovato As Boolean
  Set WMI = GetObject("winmgmts:")
  Trovato = False
  For Each DSK In WMI.ExecQuery("Select * from Win32_LogicalDisk Where DeviceID = """ & DriveLetter & """")
    MsgBox "Nome: " & DSK.Name & vbCrLf & "Capacità: " & DSK.Size & vbCrLf & "Spazio libero: " & DSK.FreeSpace & vbCrLf & "Spazio utilizzato: " & DSK.Size - DSK.FreeSpace & vbCrLf & "Tipo:" & DSK.DriveType & vbCrLf & "FileSystem:" & DSK.FileSystem
    Trovato = True
  Next
  If Not Trovato Then MsgBox "Non esiste drive"
  Set WMI = Nothing
  Set DSK = Nothing
End Sub§


Edited by Luciano - 07/Nov/2012 at 11: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: 1972 		Direct Link To This Post Posted: 21/Nov/2012 at 21:23
Funzione 0114 Determina il tipo di drive
§TipoDrive
Sub
Varie
Luciano
§Determina il tipo di drive
http://msdn.microsoft.com/en-us/library/windows/desktop/aa394592(v=vs.85).aspx
A: C: D: E: F:§
DriveLetter
C:

 


 


 



§Public Sub TipoDrive(ByVal DriveLetter As String)
   Dim WMI As Object
  Dim DSK As Object
  Dim Trovato As Boolean
  Set WMI = GetObject("winmgmts:")
  Trovato = False
  For Each DSK In WMI.ExecQuery("Select * from Win32_LogicalDisk Where DeviceID = """ & DriveLetter & """")
  
Select Case DSK.DriveType
        Case 1
           MsgBox "No root directory. " _
                & "Drive type could not be " _
                & "determined."
        Case 2
            MsgBox "DriveType: " & vbTab _
                & "Removable drive."
        Case 3
            MsgBox "DriveType: " & vbTab _
                & "Local hard disk."
        Case 4
            MsgBox "DriveType: " & vbTab _
                & "Network disk."
        Case 5
            MsgBox "DriveType: " & vbTab _
                & "Compact disk."
        Case 6
            MsgBox "DriveType: " & vbTab _
                & "RAM disk."
        Case Else
            MsgBox "Drive type could not be" _
                & " determined."
    End Select
  Trovato = True
  Next
  
  If Not Trovato Then MsgBox "Non esiste drive"
  Set WMI = Nothing
  Set DSK = 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: 1972 		Direct Link To This Post Posted: 09/Dic/2012 at 11:38
Funzione 0115 Ricerca la parola più lunga
§MaxLenText
Funzione
Testo
Luciano
§Ricerca la parola più lunga(l'ultima) in un testo.
Segni, e punteggiatura non graditi nella statistica sono da escludere inserendoli nel valore di LettereEscluse§
Testo
133..33[]323 45645344
LettereEscluse
.,;:[]*<>+-_

 


 



§Public Function MaxLenText(ByVal Testo As String, LettereEscluse As String) As String
Dim Contatore, LunghezzaMassima, NuovoInizio, VecchioInizio As Long
Inizio = 1
LettereEscluse = Replace(LettereEscluse, " ", "")
For I = 1 To Len(LettereEscluse)
    Testo = Replace(Testo, Mid(LettereEscluse, I, 1), "")
Next I
 Testo = Testo & " "
For I = 1 To Len(Testo)
    If Mid(Testo, I, 1) = " " Then
        NuovoInizio = I + 1
        If Contatore >= LunghezzaMassima Then
            LunghezzaMassima = Contatore
            VecchioInizio = NuovoInizio - Contatore - 1
        End If
        Contatore = 0
    Else
       Contatore = Contatore + 1
    End If
Next
MaxLenText = Mid(Testo, VecchioInizio, LunghezzaMassima)
MsgBox "La parola più lunga è. " & MaxLenText & " di " & LunghezzaMassima & " lettere "
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: 1972 		Direct Link To This Post Posted: 12/Dic/2012 at 18:19
Funzione 0116 Arrotondamento commerciale
§ArrotondaNumero
Funzione
Matematica
VediCodice
§http://www.donkarl.com/it/FAQ/FAQ2Generale.htm#2.1
Arrotondamento commerciale
La differenza tra le funzioni Int e Fix risiede nel fatto che se numero è negativo, Int restituisce il primo intero negativo minore o uguale a numero, mentre Fix restituisce il primo intero negativo maggiore o uguale a numero. Int ad esempio, converte -8,4 in -9, mentre Fix converte -8,4 in -8.§
varNr
-5,888
varPl

 


 


 


§Public Function ArrotondaNumero(varNr As Variant, Optional varPl As Integer = 2) As Double
 'by Konrad Marfurt + ("" by) Luke Chung + Karl Donaubauer
    'esce se valore non numerico
    If Not IsNumeric(varNr) Then Exit Function
    ArrotondaNumero = Fix("" & varNr * (10 ^ varPl) + Sgn(varNr) * 0.5) / (10 ^ varPl)
MsgBox "Intero di un numero con funzione Int() " & vbTab & Int(varNr)
MsgBox "Intero di un numero con funzione Fix() " & vbTab & Fix(varNr)
MsgBox ArrotondaNumero
End Function§

Arrotondamento per difetto o per eccesso by Alex  quì:



Edited by Luciano - 12/Dic/2012 at 19:52
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: 1972 		Direct Link To This Post Posted: 20/Dic/2012 at 09:59
Funzione 0117 Verifica la presenza di una tabella
§EsistenzaTabella
Funzione
Tabella
Luciano
§Verifica l'esistenza di una tabella§
Nome
funzioni

 


 


 



§Public Function EsistenzaTabella(Nome As String) As Boolean
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentData
    EsistenzaTabella = False
    For Each obj In dbs.AllTables
         If obj.Name = Nome Then EsistenzaTabella = True: GoTo esci
    Next obj
esci:    MsgBox EsistenzaTabella
Set obj = Nothing
Set dbs = Nothing
End Function§


Edited by Luciano - 09/Gen/2013 at 09:36
Dio è Amore e Pace
Catalogo funzioni
Back to Top
 Post Reply Post Reply Page  <1 1112131415 19>
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.11
Copyright ©2001-2012 Web Wiz Ltd.

This page was generated in 0,359 seconds.