Witam
Widziałem już tę technikę, ale wolałbym wybrać
Może brakuje jakiegoś odniesienia?
Zapoznaj się z tym tematem, jeśli znajdziesz odpowiednie rozwiązanie:
https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:QG0F7bLmQaOUb70yb4BJfw
Wypróbowałem kilka makr, jedno Christiana Chu działa, ale nie otwiera okna dialogowego, którego szukam, jest to uproszczona wersja wyboru folderów, którą otwiera z mojej strony, inne makra nie działają
stare makro wywala Excela i SW
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
Private Declare ptrsafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare ptrsafe Function lstrcat Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare ptrsafe Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare ptrsafe Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function ChoixDossier(Titre)
Dim Rien As Integer
Dim Liste As Long
Dim Resultat As String
Dim Browse_info As BrowseInfo
With Browse_info
.lpszTitle = lstrcat(Titre, "")
.ulFlags = 1
End With
Liste = SHBrowseForFolder(Browse_info)
If Liste Then
Resultat = String$(260, 0)
SHGetPathFromIDList Liste, Resultat
CoTaskMemFree Liste
Rien = InStr(Resultat, vbNullChar)
If Rien Then
ChoixDossier = Left$(Resultat, Rien - 1)
End If
End If
End Function
Sub Test()
MsgBox ChoixDossier("Choisissez le dossier")
End Sub
to, czego szukam, to odpowiednik msoFileDialogFolderPicker / Application.FileDialog(4). Pokazać
To okno dialogowe można aktywować jak na zrzucie ekranu, ale nie widzę, jak go uruchomić z vba
capture_000130.png
Właśnie znalazłem ten temat na tym samym forum:
https://www.lynkoa.com/forum/import-export-formats-neutres/vba-afficher-bo%C3%AEte-de-dialogue-de-s%C3%A9lection-de-dossier-avec-chem
Przy odrobinie szczęścia znajdziesz to, czego szukasz.
Witam
Nie powoduje to wyświetlenia poprawnego okna dialogowego
Musisz spojrzeć na ostatni post poprzedniego linku, który odnosi się do linku i postu @liryc
https://www.lynkoa.com/forum/solidworks/bouton-parcourir-macro-vba
Mam nadzieję, że tym razem jest to właściwe okno dialogowe:
Dla kodu w 1. module:
Dim swApp As SldWorks.SldWorks
Dim FileName As String
Dim Filter As String
Dim fileConfig As String
Dim fileDispName As String
Dim fileOptions As Long
'Sub main()
'Set swApp = Application.SldWorks
'Filter = "SolidWorks Files (*.slddrw)|*.slddrw" 'Filtre les types de fichiers
'FileName = swApp.GetOpenFileName("File to Attach", "", Filter, fileOptions, fileConfig, fileDispName)
'End Sub
Dim MonDoss As String
Sub main()
MonDoss = FolderBrowse("Choisir un répertoire à traiter...", "C:\")
End Sub
W innym module dla tego samego pliku swp:
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
Public Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal Hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)
Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const CSIDL_DRIVES As Long = &H11
Private Const WM_USER As Long = &H400
Private Const MAX_PATH As Long = 260
'// message from browser
Private Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_VALIDATEFAILEDA As Long = 3 '// lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW As Long = 4 '// lParam:wzPath ret:1(cont),0(EndDialog)
Private Const BFFM_IUNKNOWN As Long = 5 '// provides IUnknown to client. lParam: IUnknown*
'// messages to browser
Private Const BFFM_SETSTATUSTEXTA As Long = WM_USER + 100
Private Const BFFM_ENABLEOK As Long = WM_USER + 101
Private Const BFFM_SETSELECTIONA As Long = WM_USER + 102
Private Const BFFM_SETSELECTIONW As Long = WM_USER + 103
Private Const BFFM_SETSTATUSTEXTW As Long = WM_USER + 104
Private Const BFFM_SETOKTEXT As Long = WM_USER + 105 '// Unicode only
Private Const BFFM_SETEXPANDED As Long = WM_USER + 106 '// Unicode only
Public Type BrowseInfo
hWndOwner As LongPtr
pIDLRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As LongPtr
lParam As LongPtr
iImage As Long
End Type
'====== Folder Browser for 64 bit VBA 7 ========
Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String
Dim ReturnPath As String
Dim b(MAX_PATH) As Byte
Dim pItem As Long
Dim sFullPath As String
Dim bi As BrowseInfo
Dim ppidl As Long
sInitFolder = CorrectPath(sInitFolder)
' Note VBA windows and dialogs do not have an hWnd property.
bi.hWndOwner = 0 'Windows Main Screen handle.
' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl
bi.pIDLRoot = 0 'ppidl
bi.pszDisplayName = VarPtr(b(0))
bi.lpszTitle = sDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS
If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
bi.lParam = StrPtr(sInitFolder)
pItem = SHBrowseForFolder(bi)
If pItem Then ' Succeeded
sFullPath = Space$(MAX_PATH)
If SHGetPathFromIDList(pItem, sFullPath) Then
ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
CoTaskMemFree pItem
End If
End If
If ReturnPath <> "" Then
If Right$(ReturnPath, 1) <> "\" Then
ReturnPath = ReturnPath & "\"
End If
End If
FolderBrowse = ReturnPath
End Function
' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Private Function BFFCallback(ByVal Hwnd As LongPtr, ByVal uMsg As LongPtr, ByVal lParam As LongPtr, ByVal sData As String) As LongPtr
If uMsg = BFFM_INITIALIZED Then
SendMessageA Hwnd, BFFM_SETSELECTIONA, True, ByVal sData
End If
End Function
Private Function PtrToFunction(ByVal lFcnPtr As LongPtr) As LongPtr
PtrToFunction = lFcnPtr
End Function
Private Function CorrectPath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
Else
If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root
End If
CorrectPath = sPath
End Function
Public Function FolderExists(ByVal sFolderName As String) As Boolean
Dim att As Long
On Error Resume Next
att = GetAttr(sFolderName)
If Err.Number = 0 Then
FolderExists = True
Else
Err.Clear
FolderExists = False
End If
On Error GoTo 0
End Function
Witam
nie jest to właściwe okno dialogowe, które jest wyświetlane, ponadto jest to prawdziwa fabryka gazu, która wywala SW w domu i którą można napisać znacznie krótszym kodem w exe, które już widziałem
Witaj @ll,
Kod początkowego makra odwołuje się do obiektu fileDialog , który istnieje w pakiecie Microsoft Office, ale nie w interfejsach API VBA lub SolidWorks.
Jeśli na komputerze jest zainstalowany program Excel, może zadziałać następujący kod, który używa obiektu Aplikacja programu Excel .
Pozdrowienia.
Option Explicit
Sub selectionDossier()
' Valeur de constante à passer à fileDialog en fonction de l'usage attendu (cf. aide Microsoft)
Const msoFileDialogOpen = 1 ' Permet à l'utilisateur d'ouvrir un fichier.
Const msoFileDialogSaveAs = 2 ' Permet à l'utilisateur d'enregistrer un fichier.
Const msoFileDialogFilePicker = 3 ' Permet à l'utilisateur de sélectionner un fichier.
Const msoFileDialogFolderPicker = 4 ' Permet à l'utilisateur de sélectionner un dossier.
Dim xlsheet As Object
Dim xlFileDialog As Object
Dim dossier As String
Set xlsheet = CreateObject("Excel.Sheet")
Set xlFileDialog = xlsheet.Application.FileDialog(msoFileDialogFolderPicker)
With xlFileDialog
.Title = "Selectionner dossier"
.InitialFileName = "C:\"
.Show
dossier = .SelectedItems(1)
End With
Set xlsheet = Nothing
If Len(dossier) > 0 Then
MsgBox "Dossier sélectionné : " & dossier
Else
MsgBox "Abandon"
End If
End Sub
1 polubienie
Działa dobrze, dziękuję
Jeśli ktoś ma kod do okna dialogowego SW, a nie Excela, powinien być krótszy
Dodałem wielkość liter przycisku cofania
Sub selectionDossier()
'Const msoFileDialogOpen = 1 ' Ouvrir un fichier
'Const msoFileDialogSaveAs = 2 ' Enregistrer un fichier
'Const msoFileDialogFilePicker = 3 ' Sélectionner un fichier
Const msoFileDialogFolderPicker = 4 ' Sélectionner un dossier
Dim xlsheet As Object
Dim xlFileDialog As Object
Dim dossier As String
Set xlsheet = CreateObject("Excel.Sheet")
Set xlFileDialog = xlsheet.Application.FileDialog(msoFileDialogFolderPicker)
With xlFileDialog
.Title = "Selectionner dossier"
.InitialFileName = "C:\"
If .Show <> 0 Then '<> BT Annuler
dossier = .SelectedItems(1)
End If
End With
Set xlsheet = Nothing
End Sub
Nie ma to nic wspólnego z tematem
Dla zainteresowanych udostępniłem makro Minecrafta na SW: Społeczność Lynkoa / TUTORIALE
Dzięki za kod @m.blt
wystarczy zastąpić blok With tym kodem, aby obsłużyć błąd przy anulowaniu:
dossier = vbNullString
With xlFileDialog
.Title = "Selectionner dossier"
.InitialFileName = "C:\"
.Show
On Error Resume Next 'gère la cancel error
dossier = .SelectedItems(1)
End With
Bezpośrednio przez solidworks = niemożliwe z FileDialog, jak mówi @m.blt :
https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:oJZLfucoQ9OmlIPXWjDnzA
Znaleziono 2 metody okrężne:
https://thecadcoder.com/vba/browse-solidworks-file/
jeden za pomocą Excela, takiego jak @m.blt, a drugi, który tak naprawdę nie wygląda lepiej (ani szybciej, ani krócej) za pomocą formularza użytkownika (do przetestowania, jeśli chcesz).
Niekoniecznie proszę o wywołanie pudełka przez FileDialog, bez względu na kod
To okno dialogowe istnieje w SolidWorks, ponieważ można je otworzyć w następujący sposób
capture_000131.png
Istnieje, ale niestety SW nie jest zakodowany w vba, więc nie wszystko, co istnieje w SW, istnieje w vba.
Nie opanowałem wszystkich form programowania, ale czasami widziałem kody, które wywołują 'powłokę coś' myślę, że jeśli ktoś dobrze zna się na programowaniu, to może dałoby się wywołać to okno dialogowe, tak jak korzystają z niego opcje wbudowanego okna dialogowego SW
Podstawowym problemem jest vba pod 64 bity, ponieważ poniżej 32 dostępnych jest o wiele więcej kontrolek, w tym dialogów, niekompatybilnych z vba 64... To nienormalne, rozdzierające serce i frustrujące...
Ja też potrzebuję tego dialogu i doprowadza mnie to do szału. Okno dialogowe programu Excel to prowizorka (dzięki @m.blt ), ale otwiera się tak wolno...
Cóż, to powolne otwieranie okna dialogowego popchnęło mnie do przetestowania na podstawie @m.blt , aby było szybsze. Co też zrobiłem, oprócz zmniejszenia rozmiaru kodu. Zrobiłem z tego funkcję mimochodem. Oto ona:
Dim xlFolderDlg As Office.FileDialog
Private Sub UserForm_Initialize()
Set xlFolderDlg = Excel.Application.FileDialog(4)
End Sub
Function FolderDialog$(Optional folder$)
With xlFolderDlg
.Title = "Sélectionner un dossier"
.ButtonName = "Sélectionner"
.InitialFileName = folder
If .Show Then folder = .SelectedItems(1)
End With
FolderDialog = folder
End Function
Private Sub CMDfolderDlg_Click()
TXTfolder = FolderDialog(TXTfolder)
End Sub
.
Gdzie CMDfolderDlg to CommandButton, a TXTfolder to TextBox.
Jest jednak jedna wada; Po zamknięciu okna dialogowego formularz nie odzyskuje ręki (okno jest odznaczone). Szkoda, ale nie dramatycznie.
interesujący
Mam błąd kompilacji w 1 wierszu
Witam
Kod @Sylk wymaga użycia formularza (UserForm w VBA) z przyciskiem i polem tekstowym w celu aktywacji funkcji.
Nie zapomnij dodać odwołań do pakietu Office i programu Excel do strony odwołań VBA, zaznaczając odpowiednie pola (patrz ilustracja poniżej).
Załączone makro powinno być sprawne.
Pozdrowienia.
explorerfiles.swp powiedział:
2 polubienia
Rzeczywiście , @m.blt dziękuję. Tylko, że jak w międzyczasie edytowałem swoją wiadomość i nazwę przycisku z CMDopenFolder na CMDfolderDlg (aby była bardziej spójna) muszę podmienić nazwę przycisku w załączonym pliku swp.
Osobiście używam TextBoxa w trybie Locked true, dzięki czemu jego zawartość jest widoczna, wybieralna i przewijana (gdy jest dłuższa niż pole tekstowe), ale bez możliwości modyfikowania jej przez pisanie, aby uniknąć zarządzania zabronionymi znakami.
Aby ustawić folder domyślny, po prostu zmień jego właściwość Text podczas tworzenia formantu. Lub pozostaw to pole puste, co domyślnie otworzy "moje dokumenty".