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 1011121314 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: 05/Apr/2012 at 17:08
Funzione n.097 Importazione di un file csv
§ImportaCSV
Sub
Tabella
Luciano
§Importazione di un file di testo con delimitatori.
Il file deve trovarsi nella stessa cartella.
Il primo valore di ogni riga deve essere l'identificatore primario.
Occorre inserire il tipo di delimitatore e il numero di campi che compongono il record.
Tutti i valori sono di tipo string; dopo l'importazione si possono cambiare i tipi di dati. Con il tipo numerico e valuta non si sono riscontrati problemi.
Viene creata una tabella dal nome predeterminato che non deve esistere in precedenza.§
NomeFile
VBTest
NomeTabella
MiaTabella
NumeroCampi
4
Delimitatore
;


§Public Sub ImportaCSV(NomeFile, NomeTabella, NumeroCampi, Delimitatore)
Dim rs As New Adodb.Recordset
Dim fld As Adodb.Field
Dim NomeCampo As Variant
Dim testo, riga   As String
Dim matrice(255) As String
Dim Contatore As Integer
Dim ElencoCampi As String
'''''''''''''''''''CREAZIONE DI UNA TABELLA AVENTE UN NUMERO DI CAMPI PREDETERMINATO E PER NOME CAMPO "campo1, campo2 " ecc
For Contatore = 1 To NumeroCampi
    ElencoCampi = ElencoCampi & "Campo" & Contatore & " CHAR(255),"
Next Contatore
ElencoCampi = Left(ElencoCampi, Len(ElencoCampi) - 1)
DoCmd.RunSQL "CREATE TABLE  " & NomeTabella & "(" & ElencoCampi & ")"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs.Open "select * from " & NomeTabella & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set flds = rs.Fields
DoCmd.SetWarnings False
NomeFile = Application.CurrentProject.Path & "\" & NomeFile & ".txt"
NumeroRiga = 0
Open NomeFile For Input As #1
      Do Until EOF(1)
          Line Input #1, riga
          riga = riga & Delimitatore
          Contatore = 0
          '''''''''''''memorizza i dati delimitati dal punto e virgola in un array
          For Contatore = 1 To NumeroCampi
                Sinistra = Left(riga, InStr(riga, Delimitatore) - 1)
                matrice(Contatore) = Sinistra
                riga = Right(riga, Len(riga) - InStr(riga, Delimitatore))
          Next Contatore
          ''''''''''''''''''''''''''INSERIMENTO DI UN RECORD CON LA SOLA CHIAVE PRIMARIA
          NomePrimoCampo = flds(0).Name
          ValorePrimoCampo = matrice(1)
          DoCmd.RunSQL "Insert into " & NomeTabella & "(" & NomePrimoCampo & ") values(""" & ValorePrimoCampo & """)"
          Contatore = 0
          ''''''''''''''''''''''''''UPDATE  DEI  RECORD CON  I VALORI DEI RIMANENTI CAMPI
          For Each fld In flds
            NomeCampo = fld.Name
            Contatore = Contatore + 1
            If NomeCampo <> NomePrimoCampo Then DoCmd.RunSQL "Update  " & NomeTabella & "  set " & NomeCampo & " =  """ & matrice(Contatore) & """ where " & NomePrimoCampo & "= """ & ValorePrimoCampo & """"
          Next
        Loop
Close #1
rs.Close
Set rs = Nothing
DoCmd.SetWarnings True
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: 10/Apr/2012 at 13:05
Funzione n.098 Ultimo giorno del mese
§UltimoGiornoMese
Funzione
Data e ora
Luciano
§Ricava l'ultimo giorno del mese per una data predeterminata§
Data
31/12/2012

 

 

 


§Public Function UltimoGiornoMese(Data)
Dim NuovaData As Date
Mese = Month(Data)
NuovaData = Data
While Month(NuovaData) = Mese
    UltimoGiornoMese = Day(NuovaData)
    NuovaData = DateAdd("d", 1, NuovaData)
Wend
MsgBox UltimoGiornoMese &  vbCrLf &"Oppure in alternativa " & vbCrLf & "Day(DateSerial(Year(Data), Month(Data) + 1, 0))=" & Day(DateSerial(Year(Data), Month(Data) + 1, 0))
'Seconda funzione by Alex
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/Apr/2012 at 13:19

Funzione n.099 Creazione di una tabella dinamica

§CreaTabellaDinamica
Sub
Tabella
Luciano
§Creazione dinamica di una tabella avente
 x  numero di campi
"campo1, campo2 ecc "come nome campi
tipo testo§
NumeroCampi
4
NomeTabella
MiaTabella

 

 


§Public Sub CreaTabellaDinamica(NumeroCampi, NomeTabella)
Dim Stringa As String
For Contatore = 1 To NumeroCampi
    Stringa = Stringa & "Campo" & Contatore & " CHAR(255),"
Next Contatore
Stringa = Left(Stringa, Len(Stringa) - 1)
DoCmd.RunSQL "CREATE TABLE  " & NomeTabella & "(" & Stringa & ")"
End Sub§



Edited by Luciano - 10/Apr/2012 at 13:20
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/Apr/2012 at 10:11

Funzione 0103 Eseguire un File, di norma Batch o Exe in modalità SINCRONA

§ShellEX
Funzione
FileCartelle
Alex
§Consente di eseguire un File, di norma Batch o Exe in modalità SINCRONA, quindi il ritorno dalla chiamata avverrà solo al termine.
Nel mdb inseriamo il valore di windowstyle nella forma numerica. Mentre per l'applicazione pratica possiamo usare anche la costante corrispondente e dichiarare "ByVal windowstyle as Integer"
vbHide= 0; vbNormalFocus= 1; vbMinimizedFocus= 2; vbMaximizedFocus= 3; vbNormalNoFocus= 4;vbMinimizedNoFocus= 6
Richiamiamo con:
X=ShellEX("c:\lista.bat",vbHide,True)§
Percorso
C:\Users\Luciano2\Desktop\messaggio.bat
windowstyle
1
Wait
True

 


§Public Function ShellEX(ByVal Percorso As String, _
            ByVal windowstyle, _
            ByVal Wait As Boolean) As Boolean
           Dim x As Variant
     windowstyle = CVar(windowstyle)           
On Error GoTo Err_Shell
     Dim wshell As Object
     ShellEX = False
     Set wshell = CreateObject("WScript.shell")
     wshell.Run Percorso, windowstyle, Wait
     Set wshell = Nothing
     ShellEX = True
Exit_Here:
     Exit Function
Err_Shell:
     Resume Exit_Here
End Function§



Edited by Luciano - 12/Apr/2012 at 16:51
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/Apr/2012 at 13:46

"Modifica contemporanea di record" evitare il messaggio di Access.
Più volte si è scritto che non è possibile  evitare questo messaggio causato dall' accesso contemporaneo allo stesso set di record, per esempio modificando un controllo associato ad un campo di tale set e contemporaneamente mandando in esecuzione un codice che agisce sullo stesso set.
Una soluzione sarebbe proprio evitare l'azione contemporanea.
Lo scenario è quello di una maschera associata alla tabella domande e una sottomaschera che controlla la tabella risposte.
Ci sono  quattro possibili risposte e bisogna sceglierne una tramite una casella di  controllo associata al campo booleano RispostData
Per dare una risposta secca occorre spuntare il controllo associato (prima modifica) e contempooraneamente se un'altra risposta era precedente selezionata (seconda modifica), si vorrà che essa assuma il valore false (perda il segno di spunta).
Questo può essere ottenuto con del codice che dia l'Update alla tabella risposte settando a "false" tutti i campi RispostaData per la domanda in questione.
Il che porta all'apparizione del messaggio incriminato. (due modifiche dallo stesso utente ma con strumenti diversi)
Soluzione per lo scenario presentato.

1)Pur mantenendo associato il controllo al campo settiamone la proprietà Bloccato a Sì.
2)All'evento  "Su attivato", scriviamo la ruotine che dapprima setta i tutti i valori di RispostData  per quella domanda a false e subito dopo il valore del campo del controllo attivo a true; ancor il requery per rendere visibile la modifica.


Private Sub TRispostaData_GotFocus()
 Cambia
End Sub

Private Sub Cambia()
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "update Risposte set RispostaData= False  Where IdDomanda= " & TIdDomanda & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rst.Open "update Risposte set RispostaData= True Where IdRisposta= " & Me.TIDRisposta & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Me.Requery
Set rst = Nothing
End Sub



Edited by Luciano - 09/Feb/2013 at 19:26
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: 13/Apr/2012 at 09:19
Funzione 0105 Trasforma i tipi di dati testo/Data
§CambiaTipo
Sub
Tabella
Luciano
§Trasforma il tipo di dati "testo" in "data" delle colonne di una tabella.§
Tabella
Tabella1

 

 

 


§Public Sub CambiaTipo(tabella)
Dim MatriceCampi() As String
Dim rs As New Adodb.Recordset
Dim fld As Adodb.Field
Dim Contatore, Lunghezza, numerocolonne As Byte
Contatore = 0
rs.Open "select * from  " & tabella & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
numerocolonne = rs.Fields.Count
ReDim MatriceCampi(numerocolonne, 2) As String
Set flds = rs.Fields
For Each fld In flds
    Contatore = Contatore + 1
    MatriceCampi(Contatore, 1) = fld.Name
    MatriceCampi(Contatore, 2) = fld.Type
Next
rs.Close
Set rs = Nothing
For Contatore = 1 To numerocolonne
    If MatriceCampi(Contatore, 2) = 202 Then DoCmd.RunSQL "ALTER TABLE " & tabella & " ALTER COLUMN  " & MatriceCampi(Contatore, 1) & " DateTime "
Next Contatore
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: 13/Apr/2012 at 09:30

Funzione 0106  Aggiunge campo contatore

§AggiungiColonna_Ado
Sub
Tabella
Luciano
§Aggiungere una colonna contatore ad una tabella, con Ado.§
Tabella
Tabella1

 

 

 


§Public Sub AggiungiColonna_Ado(tabella)
'riferimento Microsoft ADO Ext. [versione] for DLL and Security
Dim cat As New ADOX.Catalog
Dim col As New ADOX.Column
'Dim tabella As New ADOX.Table
cat.ActiveConnection = CurrentProject.Connection
'MsgBox cat.Tables.Count
With col
    .Name = "ProductID"
    .Type = adInteger
     Set .ParentCatalog = cat
    .Properties("AutoIncrement") = True
    .Properties("Seed") = CLng(10)
    .Properties("Increment") = CLng(10)
End With
cat.Tables(tabella).Columns.Append col
Set cat = Nothing
Set col = 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: 13/Apr/2012 at 19:06
Funzione 0107  Ritorna la risoluzione dello schermo
§RisoluzioneSchermo
Funzione
Win32
VediCodice
§Ritorna la risoluzione dello schermo§

 

 

 

 


§Public Function RisoluzioneSchermo()
'http://www.donkarl.com/it/faq/faq4maschere.htm#4.20
'togliere il commento alla riga seguente e incollarla sotto option explicit
'Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
  RisoluzioneSchermo = GetSystemMetrics(SM_CXSCREEN) & _
  "x" & GetSystemMetrics(SM_CYSCREEN)
MsgBox RisoluzioneSchermo
End Function§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Tommy_G View Drop Down
Veterano
Veterano
Avatar

Joined: 15/Mag/2007
Status: Offline
Points: 1470
Direct Link To This Post Posted: 14/Apr/2012 at 11:40
Alex la funzione restituisce correttamente il dato con SO XP o inferiori (testato e funziona perfettamente su Xp)
ma con seven non va , o meglio, da 1024x768 invece di 1680x1050
Quote The Win32_displayConfiguration WMI class no longer works beginning with Windows Vista. This is detailed on MSDN msdn.microsoft.com/.../aa394137(v=vs.85).aspx Instead, use the Win32_VideoController.

ciao


Edited by Tommy_G - 14/Apr/2012 at 11:43
Back to Top
Tommy_G View Drop Down
Veterano
Veterano
Avatar

Joined: 15/Mag/2007
Status: Offline
Points: 1470
Direct Link To This Post Posted: 14/Apr/2012 at 22:00
Originally posted by @Alex @Alex wrote:


Quindi ho ravanto un pò nell'MSDN ed ho recuperato questa che pare funzionare
confermo
Back to Top
 Post Reply Post Reply Page  <1 1011121314 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,078 seconds.