code aanpassen voor 64 Bit Office

Andre175 · 13 feb 2023

Goedemorgen.

Aangezien ik me een nieuwe laptop heb aangeschaft en deze met 64 bit Office draait, werkt mijn code niet meer zoals het hoort.
Gedeeltelijk is het aangepast.

Code:

Private Const GWL_STYLE As Long = -16
Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
               
 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long
 Private Declare Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As Long) As Long

 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function GetForegroundWindow _
  Lib "user32.dll" () As Long

Public Sub AddToForm(ByVal Box_Type As Long)

 Dim BitMask As Long
 Dim Window_Handle As Long
 Dim WindowStyle As Long
 Dim Ret As Long

   If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
      [COLOR="#00FF00"]Window_Handle = GetForegroundWindow()[/COLOR]
  
       WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
       BitMask = WindowStyle Or Box_Type
  
      Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
      Ret = DrawMenuBar(Window_Handle)
   End If

End Sub

de rode markering gaat nu goed, al weet ik niet of dit de juiste manier is.
Bij de groene markering gaat ie nog fout. Type komt niet overeen.
Kan iemand mij aangeven wat te wijzigen?

André

edmoor · 13 feb 2023

Er is nog een functie (DrawMenuBar) die je niet als PtrSafe hebt gedeclareerd.

Andre175 · 13 feb 2023

Code:

Private Const GWL_STYLE As Long = -16
Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
               
 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long

 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As Long) As Long

 Private Declare [COLOR="#FF0000"]PtrSafe [/COLOR]Function GetForegroundWindow _
  Lib "user32.dll" () As Long

Public Sub AddToForm(ByVal Box_Type As Long)

 Dim BitMask As Long
 Dim Window_Handle As Long
 Dim WindowStyle As Long
 Dim Ret As Long

   If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
      Window_Handle = [COLOR="#00FF00"]GetForegroundWindow()[/COLOR]
  
       WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
       BitMask = WindowStyle Or Box_Type
  
      Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
      Ret = DrawMenuBar(Window_Handle)
   End If

End Sub

Sorry... bij Function DrawMenuBar had ik al wel PtrSafe staan.

Foutmelding komt bij GetForegroundWindow()

Compileerfout:
Typen komen niet met elkaar overeen.

Ik heb mijn userform een jaar of 4 terug gemaakt, daarna weinig meer gedaan mbt code schrijven.
Heb destijds deze code ook niet zelf geschreven, maar hier in dit forum gevonden.
Nu blijkt dus dat er wat aangepast moet worden om het draaiende te krijgen voor 64 bit.
(Ik kan natuurlijk office 32bit gaan instaleren... lijkt me niet de "mooiste" oplossing)

Maar is het niet zo dat PtrSafe een controle doet of de functie wel geschikt is voor 64 bit, en zo niet, dan deze functie overslaat?

edmoor · 13 feb 2023

Het lijkt erop dat die functie een pointer naar een string levert en dan moet je meer doen:

Code:

Private Const GWL_STYLE As Long = -16
Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

 Private Declare PtrSafe Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As LongPtr, _
      ByVal nIndex As Long) As Long
               
 Private Declare PtrSafe Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As LongPtr, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long

 Private Declare PtrSafe Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As LongPtr) As Long

 Private Declare PtrSafe Function GetForegroundWindow _
  Lib "user32.dll" () As LongPtr

Public Sub AddToForm(ByVal Box_Type As Long)

 Dim BitMask As Long
 Dim Window_Handle As LongPtr
 Dim WindowStyle As Long
 Dim Ret As Long

   If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
      Window_Handle = GetForegroundWindow()
  
       WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
       BitMask = WindowStyle Or Box_Type
  
      Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
      Ret = DrawMenuBar(Window_Handle)
   End If

End Sub

Je kan het ook geschikt maken voor zowel 32- als 64-bit Office.

Code:

Private Const GWL_STYLE As Long = -16
Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowLong _
       Lib "user32.dll" _
        Alias "GetWindowLongA" _
         (ByVal hwnd As LongPtr, _
          ByVal nIndex As Long) As Long
                   
     Private Declare PtrSafe Function SetWindowLong _
      Lib "user32.dll" _
       Alias "SetWindowLongA" _
        (ByVal hwnd As LongPtr, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long) As Long
    
     Private Declare PtrSafe Function DrawMenuBar _
      Lib "user32.dll" _
       (ByVal hwnd As LongPtr) As Long
    
     Private Declare PtrSafe Function GetForegroundWindow _
      Lib "user32.dll" () As LongPtr
#Else
    Private Declare Function GetWindowLong _
       Lib "user32.dll" _
        Alias "GetWindowLongA" _
         (ByVal hwnd As Long, _
          ByVal nIndex As Long) As Long
                   
     Private Declare Function SetWindowLong _
      Lib "user32.dll" _
       Alias "SetWindowLongA" _
        (ByVal hwnd As Long, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long) As Long
    
     Private Declare Function DrawMenuBar _
      Lib "user32.dll" _
       (ByVal hwnd As Long) As Long
    
     Private Declare Function GetForegroundWindow _
      Lib "user32.dll" () As Long
#End If

Public Sub AddToForm(ByVal Box_Type As Long)
    Dim WindowStyle As Long
    Dim Ret As Long
    Dim BitMask As Long
    
    #If VBA7 Then
       Dim Window_Handle As LongPtr
    #Else
       Dim Window_Handle As Long
    #End If
 
     If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
        Window_Handle = GetForegroundWindow()
    
         WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
         BitMask = WindowStyle Or Box_Type
    
        Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
        Ret = DrawMenuBar(Window_Handle)
     End If
End Sub

Andre175 · 13 feb 2023

Oke... mijn fout.
dacht dezelfde code te hebben gekopieerd zoals ik het in mijn userform had staan.
Echter stond het bij mij ff net anders.

Ik had:

Code:

Private Declare PtrSafe Function GetWindowLong _
Lib "user32.dll" _
Alias "GetWindowLongA" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function SetWindowLong _
Lib "user32.dll" _
Alias "SetWindowLongA" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr

Private Declare PtrSafe Function DrawMenuBar _
Lib "user32.dll" _
(ByVal hwnd As LongPtr) As LongPtr

Private Declare PtrSafe Function GetForegroundWindow _
  Lib "user32.dll" () As LongPtr

Onderstaand werkt wel:

Code:

 Private Declare PtrSafe Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
               
 Private Declare PtrSafe Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long

 Private Declare PtrSafe Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As Long) As Long

 Private Declare PtrSafe Function GetForegroundWindow _
  Lib "user32.dll" () As Long

Om de code aan te passen dat ie zowel voor 32 als voor 64 bit geschikt is, had al iets over gevonden.
Maar toch weer bedankt.
Voor mij is het nu eerst opgelost.

Nu dan toch maar eens de laatste schoonheidsfoutjes eruit halen, iets wat ik al bijna 4 jaar van plan was.

Andre175 · 24 feb 2023

Goedemorgen,

Ik wil toch even terug komen op dit onderwerp aangezien er toch nog iets fout gaat.
Zodra ik de Userfom minimaliseer moet er links onder in beeld een button komen om de Userform weer terug te halen.
Echter heb ik daar nu alleen het kruisje staan om af te sluiten.

Bekijk bijlage 369180

Code:

Private Const GWL_STYLE As Long = -16
Public Const MIN_BOX As Long = &H20000
Public Const MAX_BOX As Long = &H10000

Const SC_CLOSE As Long = &HF060
Const SC_MAXIMIZE As Long = &HF030
Const SC_MINIMIZE As Long = &HF020
Const SC_RESTORE As Long = &HF120

 Private Declare PtrSafe Function GetWindowLong _
   Lib "user32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hwnd As Long, _
      ByVal nIndex As Long) As Long
               
 Private Declare PtrSafe Function SetWindowLong _
  Lib "user32.dll" _
   Alias "SetWindowLongA" _
    (ByVal hwnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) As Long

 Private Declare PtrSafe Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hwnd As Long) As Long

 Private Declare PtrSafe Function GetForegroundWindow _
  Lib "user32.dll" () As Long

Public Sub AddToForm(ByVal Box_Type As Long)

 Dim BitMask As Long
 Dim Window_Handle As Long
 Dim WindowStyle As Long
 Dim Ret As Long

   If Box_Type = MIN_BOX Or Box_Type = MAX_BOX Then
      Window_Handle = GetForegroundWindow()
  
       WindowStyle = GetWindowLong(Window_Handle, GWL_STYLE)
       BitMask = WindowStyle Or Box_Type
  
      Ret = SetWindowLong(Window_Handle, GWL_STYLE, BitMask)
      Ret = DrawMenuBar(Window_Handle)
   End If

End Sub

Kan iemand mij uitleggen waar het fout gaat?

OctaFish · 24 feb 2023

Andre175 zei:
Kan iemand mij uitleggen waar het fout gaat?

Bijvoorbeeld dat je bijlage niet te zien is (behalve voor jezelf). Voeg die toe vanuit het scherm <Ga geavanceerd>.

Andre175 · 24 feb 2023

edmoor · 24 feb 2023

Plaats een voorbeeld documentje waaarin dat gebeurt.

Andre175 · 26 feb 2023

Bekijk bijlage 2023 Ritstaat helpmij.xlsb

Bij deze een "uitgekleed" bestand.
Er zullen nu ook wel een aantal andere functies niet meer werken, maar dat maakt niet zoveel uit.

edmoor · 26 feb 2023

Bij mij staat 'ie dan links onder in m'n beeldscherm, niet links onder in het Excel scherm.

Andre175 · 27 feb 2023

Dat klopt Edmoor, bij mij ook.
Echter alleen het kruisje om af te sluiten.
Niet het vierkantje om de Userform weer terug te halen op het scherm.

edmoor · 27 feb 2023

Bij mij wel.
3 Opties.
Weer terug zetten, beeldscherm groot en sluiten.
Geen idee helaas waarom dat bij jou anders is.

Andre175 · 27 feb 2023

Kan dit ook te maken hebben met dat ik office 365 64 bit heb (jij misschien 32 bit?)

edmoor · 27 feb 2023

Werkt bij mij hetzelfde in zowel Office 64- als 32-bit.

route99 · 27 feb 2023

Is het echt een pure noodzaak om een 64 bits Office te hebben vanwege zeer grote datasets e.d die anders niet geladen kunnen worden?
Zo niet, neem anders de 32 bit dan toch? Je kunt imho zo terug, zie link.

Andre175 · 27 feb 2023

de 64 bit versie is geen pure noodzaak.

Als het bij Edmoor gewoon werkt, dan zou het bij mij ook moeten werken.
Toen ik de code net had aangepast voor 64 bit, toen had ik nog wel de keuze tussen beeldscherm groot (vierkantje) en sluiten (kruisje).
"Weer terug zetten" (het streepje) had ik niet. (op oude laptop 32 bit wel alle 3 de keuze's)

Nu is dus plots het vierkantje ook weg

Andre175 · 28 feb 2023

Afgelopen nacht een Windows update gedaan...
En nu doet ie het weer goed, lag dus niet aan de VBA code.
Vreemd...

, maar goed, het is opgelost.

code aanpassen voor 64 Bit Office

Andre175

Gebruiker

edmoor

Inventaris

Andre175

Gebruiker

edmoor

Inventaris

Andre175

Gebruiker

Andre175

Gebruiker

OctaFish

Verenigingslid

Andre175

Gebruiker

edmoor

Inventaris

Andre175

Gebruiker

edmoor

Inventaris

Andre175

Gebruiker

edmoor

Inventaris

Andre175

Gebruiker

edmoor

Inventaris

route99

Meubilair

Andre175

Gebruiker

Andre175

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy