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 89101112 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/Feb/2012 at 13:09
Funzione n.081 Alcune proprietà dei campi di una tabella
§ProprietàCampi
Sub
Tabella
Luciano
§Alcune proprietà dei campi di una tabella§
Tabella
funzioni

 

 

 


§Public Sub ProprietàCampi(Tabella)
Dim rs As New ADODB.Recordset
Dim fld As ADODB.Field
Dim ContaCampi As Integer
Dim Proprietà As String
rs.Open "select * from " & Tabella & "", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set flds = rs.Fields
i = 0
ContaCampi = 0
For Each fld In flds
    Proprietà = Proprietà & "NomeCampo: " & fld.Name & " Tipo: " & fld.Type & " Valore: " & fld.Type & vbCrLf
    ContaCampi = ContaCampi + 1
Next
MsgBox Proprietà & "Numero Campi= " & ContaCampi
MsgBox "Numero Campi= " & flds.Count
rs.Close
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: 28/Feb/2012 at 10:06
Funzione n.082 Confronto fra due stringhe

§ConfrontaStringhe
Funzione
Testo
Luciano
§Verifica se due stringhe sono della stessa lunghezza.
Se hanno la stessa lunghezza, le confronta per verificare se hanno gli stessi caratteri.
Se sono differenti, notifica posizione,  carattere  e codice ascii  della prima occorrenza.§
Stringa1
Ti voglio bene
Stringa2
Ti voglio bense
 
 

§Public Function ConfrontaStringhe(Stringa1 As String, Stringa2 As String) As Boolean
Dim Lunghezza, i As Long
ConfrontaStringhe = True
Dim Motivo As String
If Len(Stringa1) <> Len(Stringa2) Then Motivo = "per diversa lunghezza ": ConfrontaStringhe = False: GoTo Risultato
Lunghezza = Len(Stringa1)
    For i = 1 To Lunghezza
        If Mid(Stringa1, i, 1) <> Mid(Stringa2, i, 1) Then
            Motivo = " per differenza trovata alla posizione " & i & "." & vbCrLf & "La seconda stringa ha il carattere  """ & Mid(Stringa2, i, 1) & """ ascii (" & Asc(Mid(Stringa2, i, 1)) & ") differente dal carattere  """ & Mid(Stringa1, i, 1) & """ ascii ( " & Asc(Mid(Stringa1, i, 1)) & ") della prima stringa"
            ConfrontaStringhe = False: GoTo Risultato
        End If
    Next i
Risultato:
If ConfrontaStringhe Then
    msgbox ConfrontaStringhe & " Stringhe uguali " & Motivo
Else
    msgbox ConfrontaStringhe & " Stringhe diverse " & Motivo
End If
End Function§


Edited by Luciano - 05/Mar/2013 at 11:34
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: 05/Mar/2012 at 16:41
Funzione n.083 Backup del presente db
§BackUp
Sub
FileCartelle
Luciano
§crea una copia di backup nella stessa cartella con lo stesso nome e la data odierna§

 

 

 

 


§Public Sub BackUp()
Dim fso As Object
Dim risp As Integer
risp = MsgBox("vuoi aggiornare la copia del client?", 4 + 32, "SALVA DB")
If risp = vbYes Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile Application.CurrentProject.Path & "\" & CurrentProject.Name, Application.CurrentProject.Path & "\" & CurrentProject.Name & Format(Date, "dd-mm-yyyy") & ".mdb"
    Set fso = Nothing
    MsgBox "Fatto"
Else
    MsgBox "Azione annullata"
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: 07/Mar/2012 at 12:40
Funzione n.084 Importa un foglio di excel
§ImportFromExcel
Sub
Excel
Luciano
§Importare  Un foglio  di excel in una tabella.§
NomeFile
nomefile732012
Tabella
TabImportExcel
 
 

§Public Sub ImportFromExcel(NomeFile, Tabella)
On Error GoTo Err_Close
DoCmd.RunSQL "Delete * from tabella1"
   DoCmd.TransferSpreadsheet transfertype:=acImport, _
      spreadsheettype:=acSpreadsheetTypeExcel9, _
      tablename:="" & Tabella & "", _
      FileName:=Application.CurrentProject.Path & "\" & NomeFile & ".xls", _
      hasfieldnames:=True
Exit_here:
     Exit Sub
Err_Close:
   msgbox "Errore " & Str(Err.Number) & Chr(13) & Err.Description
   Resume Exit_here
End Sub§


Edited by Luciano - 17/Gen/2013 at 13:13
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: 08/Mar/2012 at 12:43
Funzione n.085 Salva col nome e formato.
§SalvaDocumentoNomeFormato
Sub
FileCartelle
Luciano
§Salva un documento  come Documento / PaginaWeb / Modello/ Testo
iL file deve essere presente nalla stessa directory del db e quivi viene salvato.§
NomeFile
canti
NuovoNome
CantiCopia
NuovoFormato
Testo

 


§Public Sub SalvaDocumentoNomeFormato(NomeFile, NuovoNome, Formato)
'early Binding
Dim objWord As Word.Application 'definisce objWord come nuova applicazione Word
Set objWord = New Word.Application
Dim objDoc As Word.Document
'apre un documento Word esistente
Set objDoc = objWord.Documents.Open(Application.CurrentProject.Path & "\" & NomeFile & ".doc")
Select Case Formato
    Case "Documento"
        objDoc.SaveAs FileName:=Application.CurrentProject.Path & "\" & NuovoNome & ".doc", FileFormat:=wdFormatDocument
    Case "PaginaWeb"
        objDoc.SaveAs FileName:=Application.CurrentProject.Path & "\" & NuovoNome & ".htm", FileFormat:=wdFormatHTML
    Case "Modello"
        objDoc.SaveAs FileName:=Application.CurrentProject.Path & "\" & NuovoNome & ".doc", FileFormat:=wdFormatTemplate
    Case "Testo"
        objDoc.SaveAs FileName:=Application.CurrentProject.Path & "\" & NuovoNome & ".txt", FileFormat:=wdFormatText
End Select
objDoc.Close: Set objDoc = Nothing: objWord.Quit: Set objWord = Nothing
'wdFormatDocument  Salva come documento Word.
'wdFormatDOSText
'wdFormatHTML  Salva testo e formattazione con i tag HTML in modo che il documento che ne risulta possa essere visualizzato con un browser Web.
'wdFormatRTF  Salva tutta la formattazione. Converte la formattazione in istruzioni che altri programmi, inclusi i programmi compatibili con Microsoft, possano leggere e interpretare.
'wdFormatTemplate  Salva come modello Word.
'wdFormatText  Salva il testo senza formattazione.
'wdFormatTextLineBreaks  No formattazione.  Utilizzare questo formato per mantenere le interruzioni di riga, ad esempio, quando si trasferiscono documenti a un sistema di posta elettronica.
'wdFormatDOSTextLineBreaks
'wdFormatUnicodeText
End Sub§



Edited by Luciano - 08/Mar/2012 at 12:43
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: 08/Mar/2012 at 16:25

Funzione n.086  Funzioni sulle date

§DataOraOggi
Sub
Data e ora
Luciano
§Funzioni sulle date:
Data odierna, ora esatta, Primo giorno di x  mesi fa; ultimo giorno del mese fra x mesi.§
Mese
3

 

 

 


§Public Sub DataOraOggi(Mese)
MsgBox "La data odierna è " & Date & vbCrLf & "L'anno in corso è il: " & Year(Date) & vbCrLf & "è il " & Month(Date) & "° mese (" & MonthName(Month(Date)) & " )" & vbCrLf & "è giorno: " & Day(Date) & " (" & WeekdayName(Weekday(Date), , 1) & " )" & vbCrLf & "Sono le: ore  " & Hour(Time) & " e " & Minute(Time) & " minuti e " & Second(Time) & " secondi" & vbCrLf & "Data e ora completa: " & Now()
MsgBox "Il primo giorno di " & Mese &   " mesi fa era il " & DateSerial(Year(Date), Month(Date) - 11, 1)
MsgBox "L'ultimo giorno del "& Mese & "°  mese prossimo sarà  il " & DateSerial(Year(Date), Month(Date) + Mese, 0)
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: 08/Mar/2012 at 17:13

Funzione n.087  Ultimo giorno lavorativo

§UltimoGiornoLavorativo
Sub
Data e ora
VediCodice
§Estrae l'ultimo giorno lavorativo Lun-Ven. del mese della data inserita§
Data
12/03/2012

 

 

 


§Public Function UltimoGiornoLavorativo(Data) As Variant
'ftp://ftp.microsoft.com/softlib/mslfiles/neatcd97.exe
Dim Data2 As Date
    Data2 = DateSerial(Year(Data), Month(Data) + 1, 0)
    Do While Weekday(Data2) = 1 Or Weekday(Data2) = 7
      Data2 = Data2 - 1
    Loop
    UltimoGiornoLavorativo = Data2
MsgBox UltimoGiornoLavorativo
End Function§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
Enzodb View Drop Down
Utente Base
Utente Base
Avatar

Joined: 20/Apr/2010
Location: Italy
Status: Offline
Points: 73
Direct Link To This Post Posted: 11/Mar/2012 at 11:33
luciano buon giorno, ascoltami ho provato a scaricare il file ma mi dà problema con l'immagine, ho provato a scaricvare l'immagine mi si apre la pagina web Frre File Hosting ma mi consente solo l'upload e non il download.....
ti ringrazio..

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: 11/Mar/2012 at 15:30

Pubblico una seconda versione aggiornata con tutte le funzioni pubblicate.

Alcune funzioni sono ancora da completare, lo stesso db è ancora da migliorare.
 
 
ciao
Dio è Amore e Pace
Catalogo funzioni
Back to Top
almorel View Drop Down
Veterano
Veterano
Avatar

Joined: 05/Set/2009
Location: Napoli
Status: Offline
Points: 1908
Direct Link To This Post Posted: 11/Mar/2012 at 17:09
Ottimo !Te lo stavo per chiedere.
Grazie.
Alberto
Back to Top
 Post Reply Post Reply Page  <1 89101112 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,047 seconds.