VBA fenètre non modal
Résolu
Jdmdb
-
Jdmdb -
Jdmdb -
Bonjour tout le monde,
J'espère que tout vas bien, moi je galère sur un petit problème en VBA excel.
Je vous explique,
grâce à la fonction que je vous met juste après, j'ouvre une fenètre qui me sert pour une fonction parcourir. Seulement, la fenètre qui s'ouvre n'est pas modal. Mon but serais de la rentre modal, sinon cela fait un peut bugger mon programme.
Est ce que quelqu'au aurais une idée?
Merci de votre aide et bonne fete de la musique
Julien
Voila le code de la fonction :
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function SelectFolder(Titre As String, Handle As Long) As String
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
strTitre = Titre
With tBrowseInfo
.hWndOwner = Handle
.lpszTitle = lstrcat(strTitre, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
strBuffer = String(260, vbNullChar)
SHGetPathFromIDList lpIDList, strBuffer
SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
End Function
et pour la lancer j'utilise la commande :
TextBox4 = SelectFolder("Sélectionnez un répertoire :", FindWindow(vbNullString, Application.Caption))
J'espère que tout vas bien, moi je galère sur un petit problème en VBA excel.
Je vous explique,
grâce à la fonction que je vous met juste après, j'ouvre une fenètre qui me sert pour une fonction parcourir. Seulement, la fenètre qui s'ouvre n'est pas modal. Mon but serais de la rentre modal, sinon cela fait un peut bugger mon programme.
Est ce que quelqu'au aurais une idée?
Merci de votre aide et bonne fete de la musique
Julien
Voila le code de la fonction :
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Public Function SelectFolder(Titre As String, Handle As Long) As String
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
strTitre = Titre
With tBrowseInfo
.hWndOwner = Handle
.lpszTitle = lstrcat(strTitre, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
strBuffer = String(260, vbNullChar)
SHGetPathFromIDList lpIDList, strBuffer
SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
End Function
et pour la lancer j'utilise la commande :
TextBox4 = SelectFolder("Sélectionnez un répertoire :", FindWindow(vbNullString, Application.Caption))
A voir également:
- VBA fenètre non modal
- Fenetre windows - Guide
- Fenêtre hors écran windows 11 - Guide
- Mcafee fenetre intempestive - Accueil - Piratage
- Fenetre de navigation privée - Guide
- Excel compter cellule couleur sans vba - Guide
2 réponses
Bonjour
je dois être à coté de la plaque mais pour sélectionner un répertoir tu peux utiliser cette fonction qui te renvoie le chemin d'accès au répertoire sans faire appel aux API
je dois être à coté de la plaque mais pour sélectionner un répertoir tu peux utiliser cette fonction qui te renvoie le chemin d'accès au répertoire sans faire appel aux API
Function recherchedossier()
'Auteurs: @+thierry_xld et michel_m
Dim ObjShell As Object, ObjFolder As Object
Dim Message As String
Dim Chemin As String
Message = "Faire la Sélection du Repertoire :"
Set ObjShell = CreateObject("Shell.Application")
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, Message, 1)
On Error Resume Next 'Si on sort sans sélection
Chemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""
If Chemin = "" Then End
recherchedossier = Chemin
End Function
