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 34567 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: 10/Mag/2011 at 08:14

Funzione n.032 Ricava le proprietà di un file

§FileProprietà
Sub
FileCartelle
Luky
§Rcava le proprietà di un file.
C:\WINDOWS\System32\boot§
NomeFile
C:\WINDOWS\System32\C_1257.NLS

 

 

 


§Public Sub FileProprietà(NomeFile)
Dim prova, stringa, M0, M1, M2, M4, M16, M32 As String
Dim attributo, result As Integer
MsgBox "Le dimensioni del file sono: " & FileLen(NomeFile) & " byte." & vbCrLf & " La data di modifica è: " & FileDateTime(NomeFile)
attributo = GetAttr(NomeFile)
 M0 = "Normale"
 M1 = "Sola lettura"
 M2 = "Nascosto"
 M4 = "File di sistema"
 M16 = "Directory o cartella"
 M32 = "Il file è stato modificato dall'ultimo backup"
Select Case attributo
Case 0
    stringa = M0         &nbs p;      'vbNormal 0
Case 1
    stringa = M1         &nbs p;      'vbReadOnly 1
Case 2
    stringa = M2         &nbs p;      'vbHidden 2
Case 4
    stringa = M4         &nbs p;      'vbSystem 4
Case 16
    stringa = M16         &nb sp;     'vbDirectory 16
Case 32
    stringa = M32         &nb sp;     'vbArchive 32
'somma di due
Case 3
    stringa = M1 & ", " & M2
Case 5
    stringa = M1 & ", " & M4
Case 17
    stringa = M1 & ", " & M16
Case 33
    stringa = M1 & ", " & M32
Case 6
    stringa = M2 & ", " & M4
Case 18
    stringa = M2 & ", " & M16
Case 34
    stringa = M2 & ", " & M32
Case 20
    stringa = M4 & ", " & M16
Case 36
    stringa = M4 & ", " & M32
Case 48
    stringa = M16 & ", " & M32
'Somma di tre
Case 7
    stringa = M1 & ", " & M2 & ", " & M4
Case 19
    stringa = M1 & ", " & M2 & ", " & M16
Case 22
    stringa = M1 & ", " & M4 & ", " & M16
Case 22
    stringa = M2 & ", " & M4 & ", " & M16
Case 35
    stringa = M1 & ", " & M2 & ", " & M32
Case 37
    stringa = M1 & ", " & M4 & ", " & M32
Case 49
    stringa = M1 & ", " & M16 & ", " & M32
Case 38
    stringa = M2 & ", " & M4 & ", " & M32
Case 50
    stringa = M2 & ", " & M16 & ", " & M32
Case 52
    stringa = M4 & ", " & M16 & ", " & M32
'somma di quattro
Case 51
    stringa = M1 & ", " & M2 & ", " & M16 & ", " & M32
Case 53
    stringa = M1 & ", " & M4 & ", " & M16 & ", " & M32
Case 54
    stringa = M2 & ", " & M4 & ", " & M16 & ", " & M32
'somma di cinque
Case 55
    stringa = M1 & ", " & M2 & ", " & M4 & ", " & M16 & ", " & M32
 End Select
MsgBox stringa
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/Mag/2011 at 08:16

Funzione n.033 Funzioni sulle date

§DataFunzioni4
Sub
Data e ora
Luky
§Funzioni sulle date§

 

 

 

 


§Public Sub DataFunzioni4()
MsgBox "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"
MsgBox "Il primo giorno di undici mesi fa era il " & DateSerial(Year(Date), Month(Date) - 11, 1)
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: 10/Mag/2011 at 08:17

Funzione n.034 Scambio di valori

§ScambioValori
Sub
Varie
Luky
§Scambio di valori§
Ciccio
biondo
Franco
moro

 

 


§Public Sub ScambioValori(Ciccio, Franco)
Dim Appoggio As String
    Appoggio = Ciccio
    Ciccio = Franco
    Franco = Appoggio
MsgBox "Ciccio adesso è " & Ciccio & ". Franco adesso è " & Franco
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: 10/Mag/2011 at 19:16

Funzione n.035 Determina il turno in corso

§Turno
Funzione
Data e ora
Luky
§Ricava il turno dall'0rario.(sistema mattina, pomeriggio, notte)§
orario
23:01

 

 

 


§Public Function Turno(orario)
Dim ora As Date
orario = Cdate(orario)
If orario >= #6:00:00 AM# And orario < #2:00:00 PM# Then MsgBox " primo turno del " & date
If orario >= #2:00:00 PM# And orario < #10:00:00 PM# Then MsgBox " secondo turno del " & date
If orario >= #10:00:00 PM# Then MsgBox " terzo turno del " & date
If orario < #6:00:00 AM# Then MsgBox " terzo turno del "& date-1
End Function§



Edited by Luky
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/Mag/2011 at 19:39

Funzione n.036 Trasferisce in excel due tabelle

§ExportToExcel2
Funzione
ConnessioneDatabase
Luky
§Esportare  due tabelle nello stesso file di excel,  rinominando il file prodotto con la data odierna.§

 

 

 

 


§Public Function ExportToExcel2()
   DoCmd.TransferSpreadsheet transfertype:=acExport, _
      spreadsheettype:=acSpreadsheetTypeExcel9, _
      tablename:="tabella1", _
      FileName:=Application.CurrentProject.Path & "\nomefile1.xls", _
      hasfieldnames:=True
    DoCmd.TransferSpreadsheet transfertype:=acExport, _
      spreadsheettype:=acSpreadsheetTypeExcel9, _
      tablename:="categorie", _
      FileName:=Application.CurrentProject.Path & "\nomefile1.xls", _
      hasfieldnames:=True
    
      Name Application.CurrentProject.Path & "\nomefile1.xls" As Application.CurrentProject.Path & "\nomefile" & Day(Date) & Month(Date) & Year(Date) & ".xls"
End Function§

 



Edited by Luciano - 16/Feb/2013 at 17: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: 10/Mag/2011 at 20:43

Funzione n.037 RInomina file

§RinominaFile
Sub
FileCartelle
Luky
§Rinomina un file§
VecchioNome
C:\Users\Luc\Desktop\Ciao.txt
NuovoNome
C:\Users\Luc\Desktop\Bingo.txt

 

 


§Public Sub RinominaFile(VecchioNome, NuovoNome)
Name VecchioNome As NuovoNome
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: 11/Mag/2011 at 19:04

Funzione n.038 Legge i tag di file mp3

§LeggiTag
Sub
FileCartelle
Luky
§Legge i tag di file mp3.
Dichiarare il tipo ID£V1Tag all'inizio modulo.
Presa dal sitocomune (Massimiliano Amendola)  e modificata§
Nomefile
C:\Users\Luc\Music\Battisti\Emozioni\anna.mp3

 

 

 


§Public Sub LeggiTag(Nomefile As String)
'-----------------la dichiarazione type va inserita all'inizio modulo dopo avere tolto i commenti
'Private Type ID3v1Tag
   ' sTag As String * 3
   ' sTitle As String * 30
   ' sArtist As String * 30
   ' sAlbum As String * 30
   ' sYear As String * 4
   ' sComment As String * 28
   ' bNull As Byte
   ' bTrack As Byte
    'bGenre As Byte
'End Type
'------------------------
Dim i As Integer
Dim Tag, Titolo, Artista, Album, Traccia, Genere, Anno, Commento   As String
Dim ID3v1Tags As ID3v1Tag
Open Nomefile For Binary As #1
With ID3v1Tags
    Get #1, LOF(1) - 127, .sTag
    If Not .sTag = "TAG" Then
      MsgBox "Non ci sono TAG per il file " & Nomefile
      Close #1
      Exit Sub
    End If
    Get #1, , .sTitle
    Get #1, , .sArtist
    Get #1, , .sAlbum
    Get #1, , .sYear
    Get #1, , .sComment
    Get #1, , .bNull
    Get #1, , .bTrack
    Get #1, , .bGenre
    Close #1
  Tag = "Tag: " & .sTag
  If InStr(1, Tag, Chr(0)) > 0 Then Tag = Left(Tag, InStr(1, Tag, Chr(0)) - 1)
  Titolo = "Titolo " & .sTitle
  If InStr(1, Titolo, Chr(0)) > 0 Then Titolo = Left(Titolo, InStr(1, Titolo, Chr(0)) - 1)
  Artista = "Artista: " & .sArtist
  If InStr(1, Artista, Chr(0)) > 0 Then Artista = Left(Artista, InStr(1, Artista, Chr(0)) - 1)
  Album = "Album: " & .sAlbum
  If InStr(1, Album, Chr(0)) > 0 Then Album = Left(Album, InStr(1, Album, Chr(0)) - 1)
  Traccia = "Traccia: " & .bTrack
  If InStr(1, Traccia, Chr(0)) > 0 Then Traccia = Left(Traccia, InStr(1, Traccia, Chr(0)) - 1)
  Genere = "Genere: " & .bGenre
  If InStr(1, Genere, Chr(0)) > 0 Then Genere = Left(Genere, InStr(1, Genere, Chr(0)) - 1)
  Anno = "Anno: " & .sYear
  If InStr(1, Anno, Chr(0)) > 0 Then Anno = Left(Anno, InStr(1, Anno, Chr(0)) - 1)
  Commento = "Commento: " & .sComment
  If InStr(1, Commento, Chr(0)) > 0 Then Commento = Left(Commento, InStr(1, Commento, Chr(0)) - 1)
      
  MsgBox Tag & vbCrLf & Titolo & vbCrLf & Artista & vbCrLf & Album & vbCrLf & Traccia & vbCrLf & Genere & vbCrLf & Anno & vbCrLf & Commento
   
End With
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: 12/Mag/2011 at 17:41
Funzione n.039 Apre e posizona un report

§ApriReport
Sub
Report
Luky
§Apre un report, lo posiziona sullo schermo in una predetrminata posizione e ad un ingrandimento stabilito§
NomeReport
Report_Catalogo
Sinistra
5000
Alto
0
Larghezza
10000
Altezza
12000
§Public Sub ApriReport(NomeReport, Sinistra, Alto, Larghezza, Altezza)
DoCmd.Minimize  'Riduce a icona la maschera corrente
DoCmd.Close acReport, NomeReport  'Chiude il report
DoCmd.OpenReport NomeReport, acViewPreview ' Lo riapre
DoCmd.SelectObject acReport, NomeReport, False 'Lo seleziona come corrente
DoCmd.MoveSize Sinistra, Alto, Larghezza, Altezza    'lo posiziona in alto a sinistra
DoCmd.RunCommand acCmdZoom150  'determina l'ingrandimento
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: 12/Mag/2011 at 17:43

Funzione n.040 Stampa un report

§StampaReport
Sub
Report
Luky
§Stampa il report in oggetto§
NomeReport
Report_Catalogo

 

 

 


§Public Sub StampaReport(NomeReport)
On Error GoTo No_Stampa
DoCmd.OpenReport NomeReport, acViewPreview
DoCmd.SelectObject acReport, NomeReport, False
DoCmd.RunCommand acCmdPrint
DoCmd.Close acReport, NomeReport
DoCmd.SelectObject acForm, "Menù", False
Exit_Stampa:
    Exit Sub
No_Stampa:
    If Err.Number = 2501 Then
       MsgBox "Stampa annullata dall'utente", vbInformation, _
             "Stampa Report"
    Else
        MsgBox Err.Number & " " & Err.Description
    End If
    Resume Exit_Stampa
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/Mag/2011 at 13:48

Funzione n.041 Estrae la stringa 

§EstraiStringa
Sub
Testo
Luky
§Non eseguire il codice con il pulsante " ESEGUI" ma con l'evento doppio click!
Estrae la stringa  dalla casella "Codice".
I limiti della stringa sono gli spazi " " e l'invio.
Modificando il codice è possibile porre come limiti tutti i caratteri che non comprendono numeri e alfabeto.§

 

 

 

 


§Public Sub EstraiStringa()
Dim I, Y As Byte
Dim inizio, Pos, LunghezzaStringa, LunghezzaSelezione As Integer
Dim Stringa   As String
Stringa = Forms!Menù.TCodice.Value
inizio = Forms!Menù.TCodice.SelStart
LunghezzaStringa = Len(Stringa)
If inizio >= LunghezzaStringa Then Exit Sub

Pos = inizio


For Y = 1 To 70         &nbs p;   ' il valore di y, fine stringa ricercata +1

      If Mid(Stringa, inizio + Y, 1) = " " Or Mid(Stringa, inizio + Y, 1) = Chr(13) Or Len(Stringa) < inizio + Y Or Mid(Stringa, inizio + Y, 1) > Chr(122) Or Mid(Stringa, inizio + Y, 1) < Chr(65) Then
          Exit For
      End If
Next Y


For I = 1 To 70         ' il valore di i, inizio stringa ricercata
        If inizio + Y - I = 0 Then inizio = I - Y: Exit For

             If Mid(Stringa, inizio + Y - I, 1) = " " Or Mid(Stringa, inizio + Y - I, 1) = Chr(13) Or Mid(Stringa, inizio + Y - I, 1) > Chr(122) Or Mid(Stringa, inizio + Y - I, 1) < Chr(65) Then
                     inizio = inizio
                 Exit For
             End If
 Next I
   
Forms!Menù.TCodice.SelStart = inizio - I + Y
Forms!Menù.TCodice.SelLength = I - 1
MsgBox Forms!Menù.TCodice.SelText
End Sub§

Dio è Amore e Pace
Catalogo funzioni
Back to Top
 Post Reply Post Reply Page  <1 34567 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,045 seconds.