Hallo
Ich hatte diese Technik schon gesehen, hätte aber gerne eine
Vielleicht eine fehlende Referenz?
Schauen Sie sich dieses Thema an, wenn Sie die richtige Lösung gefunden haben:
https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:QG0F7bLmQaOUb70yb4BJfw
Ich habe mehrere Makros ausprobiert, das von Christian Chu funktioniert, aber es öffnet nicht das gewünschte Dialogfeld, es ist die vereinfachte Version der Ordnerauswahl, die es für mich öffnet, die anderen Makros funktionieren nicht
Ein altes Makro stürzt Excel und SW ab
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
was ich suche, ist das Äquivalent von msoFileDialogFolderPicker / Application.FileDialog(4). Zeigen
Dieser Dialog kann wie auf dem Screenshot aktiviert werden, aber ich sehe nicht, wie ich ihn von VBA aus starten kann
capture_000130.png
Ich habe gerade dieses Thema im selben Forum gefunden:
https://www.lynkoa.com/forum/import-export-formats-neutres/vba-afficher-bo%C3%AEte-de-dialogue-de-s%C3%A9lection-de-dossier-avec-chem
Mit etwas Glück werden Sie fündig.
Hallo
Dadurch wird nicht das richtige Dialogfeld angezeigt
Sie müssen sich den letzten Beitrag des vorherigen Links ansehen, der sich auf einen Link und einen Beitrag von @liryc
https://www.lynkoa.com/forum/solidworks/bouton-parcourir-macro-vba
Ich hoffe, es ist diesmal das richtige Dialogfeld:
Für den Code im 1. Modul:
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
In einem anderen Modul für dieselbe swp-Datei:
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
Hallo
Es ist nicht das richtige Dialogfeld, das angezeigt wird, außerdem ist es eine echte Gasfabrik, die SW zu Hause abstürzt und die mit einem viel kürzeren Code in den Ex-Dateien, die ich bereits gesehen habe, geschrieben werden kann
Hallo @ll,
Der Code für Ihr erstes Makro bezieht sich auf das fileDialog-Objekt , das in Microsofts Office-Galaxie, aber nicht in VBA- oder SolidWorks-APIs vorhanden ist.
Wenn Sie Excel auf Ihrem PC installiert haben, funktioniert möglicherweise der folgende Code, der das Excel-Anwendungsobjekt verwendet.
Herzliche Grüße.
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 „Gefällt mir“
Es funktioniert gut, danke
Wenn jemand den Code für das SW-Dialogfeld anstelle von Excel hat, sollte er kürzer sein
Ich habe die Groß-/Kleinschreibung der Schaltfläche "Rückgängig" hinzugefügt
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
Hat nichts mit dem Thema zu tun
Ich habe ein Minecraft-Makro auf SW für diejenigen zur Verfügung gestellt, die es interessiert: Lynkoa Community / TUTORIALS
Danke für den Code @m.blt
Sie müssen nur den With-Block durch diesen Code ersetzen, um den Fehler beim Abbruch zu behandeln:
dossier = vbNullString
With xlFileDialog
.Title = "Selectionner dossier"
.InitialFileName = "C:\"
.Show
On Error Resume Next 'gère la cancel error
dossier = .SelectedItems(1)
End With
Über solidworks direkt = unmöglich mit FileDialog wie @m.blt sagt:
https://r1132100503382-eu1-3dswym.3dexperience.3ds.com/#community:yUw32GbYTEqKdgY7-jbZPg/iquestion:oJZLfucoQ9OmlIPXWjDnzA
Es wurden 2 Umwegmethoden gefunden:
https://thecadcoder.com/vba/browse-solidworks-file/
eine über Excel wie @m.blt und eine andere, die nicht wirklich besser aussieht (nicht schneller oder kürzer) über userform (zum Testen, wenn Sie möchten).
Ich frage nicht unbedingt nach dem Aufruf der Box durch FileDialog, unabhängig vom Code
Dieses Dialogfeld existiert in SolidWorks, da es wie folgt geöffnet werden kann
capture_000131.png
Es existiert, aber leider ist SW nicht in vba codiert, so dass nicht alles, was in SW existiert, in vba existiert.
Ich beherrsche nicht alle Formen der Programmierung, aber ich habe manchmal Codes gesehen, die 'shell something' aufrufen. Ich denke, wenn jemand sich gut mit Programmierung auskennt, könnte es möglich sein, diesen Dialog aufzurufen, genau wie die Optionen des integrierten SW-Dialogfelds ihn verwenden
Das Grundproblem ist VBA unter 64 Bit, denn unter 32 gibt es viel mehr Steuerelemente, einschließlich Dialoge, die mit VBA 64 nicht kompatibel sind... Es ist abwegig, herzzerreißend und frustrierend...
Ich brauche auch diesen Dialog und er macht mich verrückt. Der Excel-Dialog ist eine Notlösung (danke @m.blt ), aber er öffnet sich so langsam...
Nun, diese Langsamkeit beim Öffnen des Dialogfelds hat mich dazu veranlasst, auf der Grundlage von @m.blt zu testen, um es schneller zu machen. Was ich getan habe, zusätzlich zu der Reduzierung der Größe des Codes. Ich habe es nebenbei zu einer Funktion gemacht. Hier ist:
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
.
Dabei ist CMDfolderDlg ein CommandButton und TXTfolder ein TextBox.
Es gibt jedoch einen Nachteil; Wenn das Dialogfeld geschlossen wird, wird die Hand im Formular nicht wiederhergestellt (die Auswahl des Fensters ist aufgehoben). Schade, aber nicht dramatisch.
interessant
Ich habe einen Kompilierungsfehler in der 1. Zeile
Hallo
Der @Sylk Code erfordert die Verwendung eines Formulars (UserForm in VBA) mit einer Schaltfläche und einem Textfeld, um die Funktion zu aktivieren.
Vergessen Sie nicht, der VBA-Referenzseite Verweise auf Office und Excel hinzuzufügen, indem Sie die entsprechenden Kästchen ankreuzen (siehe Abbildung unten).
Das angehängte Makro sollte funktionsfähig sein.
Herzliche Grüße.
explorerfiles.swp
2 „Gefällt mir“
In der Tat, @m.blt, danke. Da ich in der Zwischenzeit meine Nachricht bearbeitet habe und den Namen der Schaltfläche von CMDopenFolder zu CMDfolderDlg (um sie konsistenter zu machen), muss ich den Namen der Schaltfläche in der angehängten SWP-Datei ersetzen.
Persönlich verwende ich die TextBox im Locked true-Modus, so dass ihr Inhalt sichtbar, auswählbar und scrollbar ist (wenn er länger als die Textbox ist), aber ohne die Möglichkeit, ihn durch Tippen zu ändern, um eine Verwaltung von verbotenen Zeichen zu vermeiden.
Um einen Standardordner festzulegen, ändern Sie einfach dessen Text-Eigenschaft, wenn das Steuerelement erstellt wird. Oder lassen Sie es leer, wodurch standardmäßig "Meine Dokumente" geöffnet wird.