Thema Datum  Von Nutzer Rating
Antwort
05.09.2022 15:43:43 Eugen
NotSolved
05.09.2022 17:58:05 Gast15772
NotSolved
05.09.2022 18:20:20 Gast614
NotSolved
05.09.2022 18:25:18 Gast15772
NotSolved
05.09.2022 18:49:04 Trägheit
NotSolved
05.09.2022 18:52:15 Gast15772
NotSolved
05.09.2022 18:55:54 Trägheit
NotSolved
05.09.2022 18:57:59 Gast15772
NotSolved
05.09.2022 19:23:49 Trägheit
NotSolved
05.09.2022 22:00:28 Mase
NotSolved
08.09.2022 18:30:12 Trägheit
NotSolved
08.09.2022 20:24:47 Mase
NotSolved
06.09.2022 08:22:40 volti
NotSolved
05.09.2022 18:17:42 Gast28746
NotSolved
Rot 32bit auf 64bit Code Excel
05.09.2022 21:16:18 volti
NotSolved
06.09.2022 13:30:11 Eugen
NotSolved
10.09.2022 13:13:34 Gast4562
Solved

Ansicht des Beitrags:
Von:
volti
Datum:
05.09.2022 21:16:18
Views:
219
Rating: Antwort:
  Ja
Thema:
32bit auf 64bit Code Excel

Hallo Eugen,

habe Dir das mal (ungetestet) entsprechend angepasst, wobei ich manches anders gemacht hätte, aber Deinen Code weitgehend gelassen habe.

Kannst es ja mal testen.....

PS: Die Findwindow-Funktion ist überflüssig geworden, da das Excel-Handle nicht mehr ermittelt werden muss sondern jetzt buildin ist. lstrcat ist m.E. auch entbehrlich. Die MoveWindow-Funkion nutze ich eher nicht, ich nehme SetWindowPos.

Leider waren Deine Umsetzungen bei weitem nicht korrekt, es reicht halt nicht, einfach nur LongPtr in den Declares einzusetzen, sondern auch der Restcode muss entsprechend angepasst werden.

Zur Diskussion LongLong/LongPtr:

LongPtr ist m.E. angesagt, funktioniert unter VBA bei allen von mir zahlreich verwendeteten Funktionen. Eigentlich ist Longlong nur bei sehr wenigen Funktionen wie z.B. WindowFromPoint relevant und auch dort kann man mit Tricks ohne Longlong auskommen.

PS: Zur Umsetzung ist (m)ein API-Viewer sehr hilfreich.

Code:
 
001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
 
Option Explicit

Private Declare PtrSafe Function MoveWindow Lib "user32.dll" ( _
        ByVal hwnd As LongPtrByVal x As Long, _
        ByVal y As LongByVal nWidth As Long, _
        ByVal nHeight As LongByVal bRepaint As LongAs LongPtr
Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" ( _
        ByVal nIndex As LongAs Long
Private Declare PtrSafe Function GetWindowRect Lib "user32.dll" ( _
        ByVal hwnd As LongPtrByRef lpRect As RECTAs Long
Private Declare PtrSafe Function CoTaskMemFree Lib "ole32" ( _
        ByVal hMem As LongPtrAs LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" ( _
        ByVal pList As LongPtrByVal lpBuffer As StringAs LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32.dll" ( _
        ByVal hwnd As LongPtrByVal Msg As Long, _
        wParam As LongPtr, lParam As AnyAs LongPtr

Private Declare PtrSafe Function SHBrowseForFolderA Lib "Shell32.dll" ( _
        lpBrowseInfo As InfoTAs LongPtr

Private Type InfoT
     hwnd    As LongPtr
     Root    As LongPtr
     DisplayName As String
     Title   As String
     Flags   As Long
     FName   As LongPtr
     lParam  As LongPtr
     Image   As Long
End Type

Private Type RECT
     Left   As Long
     Top    As Long
     Right  As Long
     Bottom As Long
End Type

Private s_BrowseInitDir As String
Private Function BrowseCallback( _
  ByVal hwnd As LongPtrByVal uMsg As Long, _
  ByVal wParam As LongPtrByVal lParam As LongPtrAs Long
  If uMsg = &H1 Then
     Call SendMessageA(hwnd, &H466ByVal 1&ByVal s_BrowseInitDir)
     Call CenterDialog(hwnd)
  End If
  BrowseCallback = 0
End Function

Private Function FuncCallback(ByVal nParam As LongPtrAs LongPtr
  FuncCallback = nParam
End Function


Private Sub CenterDialog(ByVal hwnd As LongPtr)
  Dim WinRect As RECT, ScrWidth As Long, ScrHeight As Long
  Dim DlgWidth As Integer, DlgHeight As Integer

  GetWindowRect hwnd, WinRect
  DlgWidth = WinRect.Right - WinRect.Left
  DlgHeight = WinRect.Bottom - WinRect.Top
  ScrWidth = GetSystemMetrics(&H10)
  ScrHeight = GetSystemMetrics(&H11)
  MoveWindow hwnd, (ScrWidth - DlgWidth) / 2, _
  (ScrHeight - DlgHeight) / 2, DlgWidth, DlgHeight, 1
End Sub

Public Function fncGetFolder( _
  Optional ByVal sMsg As String = "Bitte wählen Sie ein Verzeichnis", _
  Optional ByVal sPath As String = "C:\") As String
  Dim xl As InfoT, IDList As LongPtr, RVal As LongPtr, FolderName As String

  If sPath Like "*.???Or sPath Like "*.????Then
     sPath = Left$(sPath, InStrRev(sPath, "\"))
  End If

  If Dir(sPath, vbDirectory) = "" Then
     sPath = ThisWorkbook.Path
  End If

  s_BrowseInitDir = sPath
  With xl
      .hwnd = Application.hwnd
      .Title = sMsg    ' lstrcat(sMsg, "")
      .Flags = &H1
      .FName = FuncCallback(AddressOf BrowseCallback)
  End With
  IDList = SHBrowseForFolderA(xl)
  If IDList <> 0 Then
     FolderName = Space(256)
     RVal = SHGetPathFromIDList(IDList, FolderName)
     CoTaskMemFree (IDList)
     FolderName = Trim$(FolderName)
     FolderName = Left$(FolderName, Len(FolderName) - 1)
  End If
  fncGetFolder = FolderName
End Function


Sub TestKHV()
  MsgBox fncGetFolder()
End Sub
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.09.2022 15:43:43 Eugen
NotSolved
05.09.2022 17:58:05 Gast15772
NotSolved
05.09.2022 18:20:20 Gast614
NotSolved
05.09.2022 18:25:18 Gast15772
NotSolved
05.09.2022 18:49:04 Trägheit
NotSolved
05.09.2022 18:52:15 Gast15772
NotSolved
05.09.2022 18:55:54 Trägheit
NotSolved
05.09.2022 18:57:59 Gast15772
NotSolved
05.09.2022 19:23:49 Trägheit
NotSolved
05.09.2022 22:00:28 Mase
NotSolved
08.09.2022 18:30:12 Trägheit
NotSolved
08.09.2022 20:24:47 Mase
NotSolved
06.09.2022 08:22:40 volti
NotSolved
05.09.2022 18:17:42 Gast28746
NotSolved
Rot 32bit auf 64bit Code Excel
05.09.2022 21:16:18 volti
NotSolved
06.09.2022 13:30:11 Eugen
NotSolved
10.09.2022 13:13:34 Gast4562
Solved