Soyez le premier à donner votre avis sur cette source.
Snippet vu 9 446 fois - Téléchargée 50 fois
A mettre dans le formulaire de la base de donné "CompactBD" dans l'execution d'un bouton clic (Comprimer par exemple) Private Sub Comando2_Click() On Error GoTo Err_Comando2_Click Dim dbs As Database, tbl As TableDef, fld As Field Dim Archivo_Comp, Archivo_bak Set dbs = CurrentDb() Set tbl = dbs.TableDefs![Camino_DB] Set fld = tbl![Path] Docmd.Minimize Archivo_Comp = fld.DefaultValue If MsgBox("Voulez vous comprimer ce fichier: " & Archivo_Comp, vbYesNo + vbExclamation, Title:="Cuidado") = vbYes Then Archivo_bak = Archivo_Comp & ".bak" FileCopy Archivo_Comp, Archivo_bak MsgBox "Un fichier de backup à ete créé: " & Archivo_bak, Title:="Informacíon", Buttons:=vbInformation If Dir("BDTemp.mdb") <> "" Then Kill "BDTemp.mdb" DBEngine.CompactDatabase Archivo_Comp, "BDTemp.mdb" FileCopy "BDTemp.mdb", Archivo_Comp If Dir("BDTemp.mdb") <> "" Then Kill "BDTemp.mdb" End If Docmd.Close Application.Quit acPrompt Err_Comando2_Click: MsgBox Err.Description Resume Exit_Comando2_Click End Sub A mettre dans un module dans la BD à compacter Function Compactar_BD() Dim dbs As DATABASE, tbl As TableDef, fld As Field Dim txt1, txt2, txt3, temp As String 'Dim c1, c2, c3 As Integer (y en a plus besoin 23-03-02) Set dbs = CurrentDb() Set tbl = dbs.TableDefs![Camino_DB] Set fld = tbl.Fields![Path] ' recupere le chemin txt1 = dbs.Name fld.DefaultValue = txt1 ' place le chemin de la BD actuelle dans le champs Path de la table Camino_DB ' corrigé le 18-11-01 txt2 = Dir(txt1) txt3 = Left$(txt1, Len(txt1) - Len(txt2)) txt3 = txt3 & "CompactDB.mdb" ' ajoute chemin a la BD CompactDB.mdb If dir(txt3) <> "" Then ' ne pas mettre "CompactDB.mdb" si non le message d'erreur n'est pas le perso Docmd.SetWarnings False Docmd.CopyObject txt3, "Camino_DB", acTable, "Camino_DB" ' copie la table Camino_DB dans la BD CompactDB.mdb Docmd.SetWarnings True temp = ShellExecute(0, "open", txt3, "", "", 1) CloseCurrentDatabase Else MsgBox "Il manque le fichier CompactDB.mdb dans le repertoire: " & txt2 & " Pas d'acces possible à la fonction.", vbCritical End If End Function ' corrigé le 23/03/02 A mettre dans un module separé (Func_Shell par ex) Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
24 oct. 2009 à 14:58
je voudre sélectionne un pays dans le comb1 pour afficher les ville de cette pays dans comb2.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.