|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
TRUCS ET ASTUCES
Information sur la source
Description
Une base de donnée sur les trucs et astuces de windows
Source
- Private Sub Command1_Click()
- Dim Recherche As String
- Dim Expression As String
- Expression = InputBox("Tapez la première lettre de la rubique a rechercher :", "Recherche d'enregistrement")
- Recherche = "Titre LIKE" & "'" & Expression & "*" & "'"
- Data1.Recordset.FindFirst Recherche
- Do While Not Data1.Recordset.NoMatch
- If MsgBox("Continuer une recherche ?", vbYesNo, "Rechercher") <> vbYes Then Exit Do
- Data1.Recordset.FindNext Recherche
- Loop
- MsgBox "Il n'y a plus d'enregistrement répondant au mot spécifié !", vbOKOnly, "Recherche"
- End Sub-
-
- Private Sub Command2_Click()
- 'Fin du programme
- M$ = "Voulez-vous vraiment quitter le programme Truc&Astuce ?"
- Réponse% = MsgBox(M$, vbYesNo + vbQuestion, "Quitter Truc&Astuce")
- If Réponse% = vbYes Then
- End
- End If
- 'Unload Me
- End Sub
-
- Private Sub Command3_Click()
- ' Attribue à CancelError la valeur True
- CommonDialog2.CancelError = True
- On Error GoTo ErrHandler
- ' Définit la propriété Flags
- CommonDialog2.Flags = cdlOFNHideReadOnly
- ' Définit les filtres
- CommonDialog2.Filter = "Bases de donnée" & _
- "(*.mdb)|*.mdb"
- ' Définit le filtre par défaut
- CommonDialog2.FilterIndex = 1
- ' Affiche la boîte de dialogue Ouverture
- CommonDialog2.ShowOpen
- ' Affiche le nom du fichier sélectionné
- MsgBox CommonDialog2.filename
- Exit Sub
-
- ErrHandler:
- 'L'utilisateur a cliqué sur Annuler
- Exit Sub
- End Sub
-
- Private Sub Command4_Click()
- Aide.Show
- End Sub
-
- Private Sub Data1_Reposition()
- Screen.MousePointer = vbDefault
- On Error Resume Next
- Data1.Caption = "Astuce N°" & (Data1.Recordset.AbsolutePosition + 1)
- End Sub
-
- Option Explicit
-
- ' Options de sécurité des clés de base de registres...
- Const READ_CONTROL = &H20000
- Const KEY_QUERY_VALUE = &H1
- Const KEY_SET_VALUE = &H2
- Const KEY_CREATE_SUB_KEY = &H4
- Const KEY_ENUMERATE_SUB_KEYS = &H8
- Const KEY_NOTIFY = &H10
- Const KEY_CREATE_LINK = &H20
- Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
- KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
- KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
-
- ' Types racines des clés de base de registres...
- Const HKEY_LOCAL_MACHINE = &H80000002
- Const ERROR_SUCCESS = 0
- Const REG_SZ = 1 ' Chaîne terminée par un caractère nul Unicode.
- Const REG_DWORD = 4 ' Nombre 32 bits.
-
- Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
- Const gREGVALSYSINFOLOC = "MSINFO"
- Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
- Const gREGVALSYSINFO = "PATH"
-
- Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
- Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
- Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
-
-
- Private Sub cmdSysInfo_Click()
- Call StartSysInfo
- End Sub
-
- Private Sub cmdOK_Click()
- Unload Me
- End Sub
-
- Private Sub Form_Load()
- Me.Caption = "À propos de " & App.Title
- lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
- lblTitle.Caption = App.Title
- End Sub
-
- Public Sub StartSysInfo()
- On Error GoTo SysInfoErr
-
- Dim rc As Long
- Dim SysInfoPath As String
-
- ' Essaie d'obtenir le chemin et le nom du programme Infos système dans la base de registre...
- If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
- ' Essaie d'obtenir uniquement le chemin du programme Infos système dans la base de registre...
- ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
- ' Valide l'existence de la version du fichier 32 bits connu.
- If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
- SysInfoPath = SysInfoPath & "MSINFO32.EXE"
-
- ' Erreur - Impossible de trouver le fichier...
- Else
- GoTo SysInfoErr
- End If
- ' Erreur - Impossible de trouver l'entrée de la base de registre...
- Else
- GoTo SysInfoErr
- End If
-
- Call Shell(SysInfoPath, vbNormalFocus)
-
- Exit Sub
- SysInfoErr:
- MsgBox "Les informations système ne sont pas disponibles actuellement", vbOKOnly
- End Sub
-
- Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
- Dim i As Long ' Compteur de boucle.
- Dim rc As Long ' Code de retour.
- Dim hKey As Long ' Descripteur d'une clé de base de registres ouverte.
- Dim hDepth As Long '
- Dim KeyValType As Long ' Type de données d'une clé de base de registres.
- Dim tmpVal As String ' Stockage temporaire pour une valeur de clé de base de registres.
- Dim KeyValSize As Long ' Taille de la variable de la clé de base de registres.
- '------------------------------------------------------------
- ' Ouvre la clé de base de registres sous la racine clé {HKEY_LOCAL_MACHINE...}.
- '------------------------------------------------------------
- rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvre la clé de base de registres.
-
- If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur...
-
- tmpVal = String$(1024, 0) ' Alloue de l'espace pour la variable.
- KeyValSize = 1024 ' Définit la taille de la variable.
-
- '------------------------------------------------------------
- ' Extrait la valeur de la clé de base de registres...
- '------------------------------------------------------------
- rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
- KeyValType, tmpVal, KeyValSize) ' Obtient/Crée la valeur de la clé.
-
- If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur.
-
- If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 ajoute une chaîne terminée par un caractère nul...
- tmpVal = Left(tmpVal, KeyValSize - 1) ' Caractère nul trouvé, extrait de la chaîne.
- Else ' WinNT ne termine pas la chaîne par un caractère nul...
- tmpVal = Left(tmpVal, KeyValSize) ' Caractère nul non trouvé, extrait la chaîne uniquement.
- End If
- '------------------------------------------------------------
- ' Détermine le type de valeur de la clé pour la conversion...
- '------------------------------------------------------------
- Select Case KeyValType ' Recherche les types de données...
- Case REG_SZ ' Type de données chaîne de la clé de la base de registres.
- KeyVal = tmpVal ' Copie la valeur de la chaîne.
- Case REG_DWORD ' Type de données double mot de la clé de base de registres.
- For i = Len(tmpVal) To 1 Step -1 ' Convertit chaque bit.
- KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construit la valeur caractère par caractère.
- Next
- KeyVal = Format$("&h" + KeyVal) ' Convertit le mot double en chaîne.
- End Select
-
- GetKeyValue = True ' Retour avec succès.
- rc = RegCloseKey(hKey) ' Ferme la clé de base de registres
- Exit Function ' Quitte.
-
- GetKeyError: ' Réinitialise après qu'une erreur s'est produite...
- KeyVal = "" ' Affecte une chaîne vide à la valeur de retour.
- GetKeyValue = False ' Retour avec échec.
- rc = RegCloseKey(hKey) ' Ferme la clé de base de registres.
- End Function
Private Sub Command1_Click()
Dim Recherche As String
Dim Expression As String
Expression = InputBox("Tapez la première lettre de la rubique a rechercher :", "Recherche d'enregistrement")
Recherche = "Titre LIKE" & "'" & Expression & "*" & "'"
Data1.Recordset.FindFirst Recherche
Do While Not Data1.Recordset.NoMatch
If MsgBox("Continuer une recherche ?", vbYesNo, "Rechercher") <> vbYes Then Exit Do
Data1.Recordset.FindNext Recherche
Loop
MsgBox "Il n'y a plus d'enregistrement répondant au mot spécifié !", vbOKOnly, "Recherche"
End Sub-
Private Sub Command2_Click()
'Fin du programme
M$ = "Voulez-vous vraiment quitter le programme Truc&Astuce ?"
Réponse% = MsgBox(M$, vbYesNo + vbQuestion, "Quitter Truc&Astuce")
If Réponse% = vbYes Then
End
End If
'Unload Me
End Sub
Private Sub Command3_Click()
' Attribue à CancelError la valeur True
CommonDialog2.CancelError = True
On Error GoTo ErrHandler
' Définit la propriété Flags
CommonDialog2.Flags = cdlOFNHideReadOnly
' Définit les filtres
CommonDialog2.Filter = "Bases de donnée" & _
"(*.mdb)|*.mdb"
' Définit le filtre par défaut
CommonDialog2.FilterIndex = 1
' Affiche la boîte de dialogue Ouverture
CommonDialog2.ShowOpen
' Affiche le nom du fichier sélectionné
MsgBox CommonDialog2.filename
Exit Sub
ErrHandler:
'L'utilisateur a cliqué sur Annuler
Exit Sub
End Sub
Private Sub Command4_Click()
Aide.Show
End Sub
Private Sub Data1_Reposition()
Screen.MousePointer = vbDefault
On Error Resume Next
Data1.Caption = "Astuce N°" & (Data1.Recordset.AbsolutePosition + 1)
End Sub
Option Explicit
' Options de sécurité des clés de base de registres...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' Types racines des clés de base de registres...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Chaîne terminée par un caractère nul Unicode.
Const REG_DWORD = 4 ' Nombre 32 bits.
Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "À propos de " & App.Title
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
lblTitle.Caption = App.Title
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Essaie d'obtenir le chemin et le nom du programme Infos système dans la base de registre...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' Essaie d'obtenir uniquement le chemin du programme Infos système dans la base de registre...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
' Valide l'existence de la version du fichier 32 bits connu.
If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "MSINFO32.EXE"
' Erreur - Impossible de trouver le fichier...
Else
GoTo SysInfoErr
End If
' Erreur - Impossible de trouver l'entrée de la base de registre...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "Les informations système ne sont pas disponibles actuellement", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Compteur de boucle.
Dim rc As Long ' Code de retour.
Dim hKey As Long ' Descripteur d'une clé de base de registres ouverte.
Dim hDepth As Long '
Dim KeyValType As Long ' Type de données d'une clé de base de registres.
Dim tmpVal As String ' Stockage temporaire pour une valeur de clé de base de registres.
Dim KeyValSize As Long ' Taille de la variable de la clé de base de registres.
'------------------------------------------------------------
' Ouvre la clé de base de registres sous la racine clé {HKEY_LOCAL_MACHINE...}.
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvre la clé de base de registres.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur...
tmpVal = String$(1024, 0) ' Alloue de l'espace pour la variable.
KeyValSize = 1024 ' Définit la taille de la variable.
'------------------------------------------------------------
' Extrait la valeur de la clé de base de registres...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Obtient/Crée la valeur de la clé.
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur.
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 ajoute une chaîne terminée par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Caractère nul trouvé, extrait de la chaîne.
Else ' WinNT ne termine pas la chaîne par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize) ' Caractère nul non trouvé, extrait la chaîne uniquement.
End If
'------------------------------------------------------------
' Détermine le type de valeur de la clé pour la conversion...
'------------------------------------------------------------
Select Case KeyValType ' Recherche les types de données...
Case REG_SZ ' Type de données chaîne de la clé de la base de registres.
KeyVal = tmpVal ' Copie la valeur de la chaîne.
Case REG_DWORD ' Type de données double mot de la clé de base de registres.
For i = Len(tmpVal) To 1 Step -1 ' Convertit chaque bit.
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construit la valeur caractère par caractère.
Next
KeyVal = Format$("&h" + KeyVal) ' Convertit le mot double en chaîne.
End Select
GetKeyValue = True ' Retour avec succès.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres
Exit Function ' Quitte.
GetKeyError: ' Réinitialise après qu'une erreur s'est produite...
KeyVal = "" ' Affecte une chaîne vide à la valeur de retour.
GetKeyValue = False ' Retour avec échec.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres.
End Function
Conclusion
Il suffit juste de laisser la base de donnée dans le meme repertoire que l'exécutable
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Sources du même auteur
Sources de la même categorie
Sources en rapport avec celle ci
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Commande SQL LIKE avec Access [ par Valere ]
Dans un script ASP j'interroge une base access avec une requete de type select * from MaTable Where MonChamp Like 't*' et je me retrouve avec un recor
Base de donnees [ par nad ]
Voila, j'ai un probleme de vb:J'ai cree une interface graphique avec des libelles, des textBox et des boutonsles TextBox sont associe à la base de don
accedez a une base de donnees qui a un mot de passe [ par madhroub_fi_ro7ou ]
je trouve pas la methode dont je pourrais y acceder a une base de donnees protege par un mot de passe, je voudrais y acceder a la base de donnees via
BASE DE DONNEES : HELP ME PLEASE [ par YOYO292 ]
J'ai un repertoire c:\Rep\Data\avec des fichiers mdb dedansj'ai une base de données c:\rep\bibilio.mdbavec une table reference avec deux champs : nom,
Enregistrement sur ACCESSSSSSSSSS [ par {-Yah!-} ]
Voila, je voudrais que dans mon prog, tous soit enregistrer sur base de donnees, on m'as dit que c'etait possible et je voudrais savori comment!!en fa
Lien vers aCCCces [ par {-Yah!-} ]
Je desirerai que les utilisateurs d'un programme soit tous referencer dans une base de donnees access et que pour entrer sur le prog, l appli se conne
base de donnees [ par dadapointcom ]
comment calculer la somme totale d'un champ dans une base de donnee? mercidada...
Importer les donnees Excel a Access [ par mel ]
Bonjour,Je un ensemble de fichiers excel que je dois importer un a un dans des differentes tables de ma base de donnees (Access).Mon probleme est que
PB DE BASE DE DONNEES EN VB: URGENT !!!!!!! [ par metal.killer ]
g réalisé uen aplication en vb ki gère des tables en DBF, mais g besoin de faire du traitement, c a dire d requetes, le plus pratique serait le SQL ma
base de donnees avec ADO, ADOX, OLEDB, ODBC??????? [ par Andrea ]
Je voudrais me connecter a une base de donnees SQL (situee sur un serveur distant SQLserver2000) a partir d'un programme VB, afin d'y effectuer des no
|
Téléchargements
Logiciels à télécharger sur le même thème :
Comparez les prix Nouvelle version

HTC G1
Entre 449€ et 449€
|