Msgbox avec une valeur en entrée Access VBA

Msgbox avec une valeur en entrée Access VBA - VB/VBA/VBS - Programmation

Marsh Posté le 27-07-2009 à 15:14:05    

Bonjour à tous,
 
Petit soucis:
 
J'aimerai faire une MsgBox personnalisée où je demande à l'utilisateur d'entrer un nom de fichier (si le fichier est déjà présent dans le répertoire) et quand il appuie sur Ok le programme récupère ce nom, et enregistre le fichier à l'endroit et sous le nom donné par l'utilisateur.
Sauf erreur VBA ne propose pas de msgbox où l'utilisateur, peut entrer une valeur, et on peut récupérer cette valeur en VBA?
 
Et donc j'ai crée un formulaire tout simple, avec une zone de texte et un bouton OK, et j'ouvre ce formulaire après avoir scanner le dossier.
Le probleme, c'est que j'aimerai stopé le code VBA, et que le code reprenne une fois que l'utilisateur à cliqué sur OK.
 
voici mon code:
cette fonction cherche dans le répertoire "chemin" si le nom du fichier existe

Code :
  1. Public Function VerifExistant(nomFichAs String, chemin As String)
  2. Dim fso As FileSystemObject, dossier As Folder, sousdossier As Folder, fichier As File
  3. Set fso = New FileSystemObject
  4. Set dossier = fso.GetFolder(chemin)
  7. For Each fichier In dossier.Files
  8.         If (InStr(1, fichier, nomFich, 1) <> 0) Then
  9.             NomsauveStat = True
  10.             DoCmd.OpenForm "Remplacer", acNormal
  11.             Form_Remplacer.TextFichExistant = Replace(nomFich, ".xls", "" )
  12.             Exit Function
  13.         End If
  14.     Next
  15. End Function


 
cette fonction s'execute lorsque l'utilisateur appui sur le formulaire Form_Remplacer:
 

Code :
  1. Private Sub Commande3_Click()
  2. NomsauveStat = False
  4. If Len(Form_Remplacer.TextFichExistant) = 0 Then
  5.     MsgBox "Vous devez écrire un nom."
  6.     Exit Sub
  7. End If
  8. If NomsauveStat = True Then
  9.     sauvegardeStat = Form_Remplacer.TextFichExistant.Value
  10.     GoTo saveStat
  11. End If
  13. NomsauveStat = False
  14. End Sub


donc le soucis c'est que le code ne sarrete pas, le formulaire Form_Remplacer est ouvert, mais le code continu, donc l'utilisateur ne peut pas changer le nom du fichier du coup!!
 
help help! jespere que j'ai été assez claire!
 
merci!!  :)

Message cité 1 fois
Reply

Marsh Posté le 27-07-2009 à 15:14:05   

Reply

Marsh Posté le 28-07-2009 à 00:36:18    

mmmxtina a écrit :

Sauf erreur VBA ne propose pas de msgbox où l'utilisateur, peut entrer une valeur, et on peut récupérer cette valeur en VBA?


 
J'ai pas lu la suite, mais regarde du coté de InputBox
Genre :
 
Toto=inputbox(Texte, Titre)


Message édité par SuppotDeSaTante le 28-07-2009 à 00:44:05

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 28-07-2009 à 15:17:54    

Désiolée de répondre aussi tard!!
c'est excatement ce qui me fallait!!
merci!

Reply

Marsh Posté le 28-07-2009 à 15:41:06    

Pas de souci
 
Tu peux aussi passer par la boite de dialogue "ouvrir" :
 

Citation :

Option Explicit
Option Compare Database
Type OPENFILENAME
lStructSize As Long                  'taille de la structure
hwndOwner As Long                    'descripteur de la fenêtre parent de la boîte de dialogue
hInstance As Long                    'instance de l'application courante
lpstrFilter As String                'définit les extensions affichées dans la b. de dialogue.
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long                 'index du filtre à utiliser par défaut.
lpstrFile As String                  'nom du fichier affiché à l'ouverture de la fenêtre
nMaxFile As Long                     'taille du tampon mémoire précédent
lpstrFileTitle As String             'contient le nom et extension du fichier sans le chemin
nMaxFileTitle As Long                'taille du tampon mémoire précédent
lpstrInitialDir As String            'répertoire initial de la boîte de dialogue
lpstrTitle As String                 'titre de la fenêtre
flags As Long                        'ensemble de constantes désignant les caractéristiques de la fenêtre
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String                'extension ajoutée par défaut si l'usager l'omet
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
 
 
'Constantes pour l'ouverture ou la sauvegarde d'un fichier
 
Public Const OFN_ALLOWMULTISELECT = &H200      'Autorise la sélection multiple de fichiers
Public Const OFN_CREATEPROMPT = &H2000         'Affiche une fenêtre de confirmation de création de fichier
Public Const OFN_ENABLEHOOK = &H20
'Public Const OFN_ENABLESIZING
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000           'Donne le style "Explorer" à la boîte de dialogue (par défaut)
Public Const OFN_EXTENSIONDIFFERENT = &H400   'Indique que l'usager a choisi une extension différente de celle par défaut
Public Const OFN_HIDEREADONLY = &H4           'Case à cocher "Lecture seule" invisible
Public Const OFN_FILEMUSTEXIST = &H1000       'Seuls les fichiers existants peuvent être saisis
Public Const OFN_LONGNAMES = &H200000         'Gestion des noms longs pour les b. de dialogue n'ayant pas le style "Explorer"
Public Const OFN_NOCHANGEDIR = &H8            'Conserve le répertoire d'origine à la fermeture de la fenêtre
Public Const OFN_NODEREFERENCELINKS = &H100000 'La b. dialogue prendra le nom et le chemin du raccourci sélectionné
Public Const OFN_NOLONGNAMES = &H40000        'Utilise les noms de fichiers courts (sans effet sur les fenêtres du type "Explorer"
Public Const OFN_NONETWORKBUTTON = &H20000    'Désactive le bouton "Réseau"
Public Const OFN_NOREADONLYRETURN = &H8000    'Ne sélectionne pas la case à cocher "Lecture seule"
Public Const OFN_NOTESTFILECREATE = &H10000   'Le fichier ne sera pas créé avant la fermeture de la fenêtre
Public Const OFN_NOVALIDATE = &H100           'Ne vérifie pas la validité de la saisie (validité du nom de fichier)
Public Const OFN_OVERWRITEPROMPT = &H2        'Afficher un msg de confirmation d 'écrasement de fichier si celui-ci existe déjà
Public Const OFN_PATHMUSTEXIST = &H800        'Les chemins et fichiers saisis doivent exister
Public Const OFN_READONLY = &H1               'La case "Lecture seule" est cochée à la création de la fenêtre
Public Const OFN_SHAREAWARE = &H4000          'Ignorer les erreurs de partage réseau
Public Const OFN_SHOWHELP = &H10              'Afficher le bouton "Aide" dans la boîte de dialogue
 
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
'Ouvrir la boîte de dialogue permettant d'ouvrir un fichier sans passer par un contrôle ActiveX
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Function OuvreBoiteDialogue() As String
' Objectif: obtenir la boîte de dialogue de Windows "Ouvrir un fichier" sans contrôle ActiveX
Dim Fichier As String
Dim Filtre As String
Dim dlgFichier As OPENFILENAME
Dim RetVal As Long
Filtre = "Tous" & vbNullChar & "*.*" & vbNullChar 'Mettre l'extension genre *.mdb; *.xls etc.
dlgFichier.lStructSize = Len(dlgFichier)
'dlgFichier.hwndOwner = Me.Hwnd
dlgFichier.hInstance = 0
dlgFichier.lpstrFilter = Filtre
dlgFichier.nFilterIndex = 1 'par défaut liste la 1ère extension définie dans le filtre
dlgFichier.lpstrFile = String(254, vbNullChar)
dlgFichier.nMaxFile = 255
dlgFichier.lpstrFileTitle = String(254, vbNullChar)
dlgFichier.nMaxFileTitle = 255
dlgFichier.lpstrInitialDir = "D:\DataAccess\"
dlgFichier.lpstrTitle = "Ouvrir un fichier"
dlgFichier.flags = OFN_FILEMUSTEXIST ' Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or 0
RetVal = GetOpenFileName(dlgFichier)
If RetVal >= 1 Then
   Fichier = dlgFichier.lpstrFile
Else
   
   Exit Function
End If
OuvreBoiteDialogue = Fichier
 
End Function
 
Sub mmmxtina()
 
   Toto = OuvreBoiteDialogue  
 
End Sub


 
 :jap:


Message édité par SuppotDeSaTante le 28-07-2009 à 15:41:57

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 29-07-2009 à 15:58:54    

super merci!!!
je vais regarder ça. ça sera surement plus classe que ma petite Inputbox!
 
merci pour ton aide dje69r!

Reply

Marsh Posté le 29-07-2009 à 16:05:56    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed