XL 2021 Modification d'un code VBA

riton00

XLDnaute Impliqué
Bonjour,

Suite à la casse de mon ancien ordinateur, j'en ai profiter pour m'en acheter un autre et repartir sur de nouvelles bases. Etant donné que j'avais à l'époque Excel 2007 je suis passé sur Excel 2021 64 bits, du coup sur un de mes fichier et que j'utilisais quotidiennement et que j'avais élaborer au fil du temps avec l'aide de contributeurs, aujourd'hui au lancement de mon fichier j'ai une erreur de compilation ci-dessous, que je n'arrive pas à résoudre vu mes basses compétences en VBA.

Erreur de compilation
"Le code contenu dans ce projet doit être mis à jour pour pouvoir être utilisé sur les systèmes 64 bits. Vérifiiez et mettez à jour les instruction Declare, puis marquez-les avec l'attribut PtrSafe"


Voici les instructions en rouge du code VBA qui me pose problème et Function est en surbriance
Public Declare Function GAW Lib "user32" Alias "GetActiveWindow" () As Long
'api pour appliquer le nouveau style a la fenetre (userform)
Public Declare Function SWLA Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'redessine la fenetre apres modification
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Ci-dessous le code complet


VB:
Option Explicit
Public flag As Boolean
'
' capture le handle de la fenetre
Public Declare Function GAW Lib "user32" Alias "GetActiveWindow" () As Long
'api pour appliquer le nouveau style a la fenetre (userform)
Public Declare Function SWLA Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'redessine la fenetre apres modification
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Sub ToucheEscape(Optional dummy As Byte)
'/// Procédure vide mais nécessaire pour le contrôle de la touche Escape (Echap) ///
End Sub

Sub PleinEcran()    '*Affichage plein écran
    SWLA GAW, -16, &H94080080: SWLA GAW, -20, &H0: DrawMenuBar GAW
    Application.OnKey "{ESCAPE}", ""
    With ActiveWindow
        .DisplayHorizontalScrollBar = False      'Masque barre horizontal
        .DisplayVerticalScrollBar = False        'Masque barre vertical
        .DisplayWorkbookTabs = False             'Masque onglets
        .DisplayHeadings = False                'Masque entetes ligne colonne
      
    End With

    With Application
        .DisplayFullScreen = True    'afficher plein ecran
        .DisplayFormulaBar = False    'Masque barre formule
    End With

End Sub
Sub Normal()    '*Rendre affichage Normal
    SWLA GAW, -16, &H94CB0080: SWLA GAW, -20, &H0: DrawMenuBar GAW
    Application.OnKey "{ESCAPE}"

    With ActiveWindow
        .DisplayHorizontalScrollBar = True      'afficher barre horizontal
        .DisplayVerticalScrollBar = True        'afficher barre vertical
        .DisplayWorkbookTabs = True             'afficher onglets
        .DisplayHeadings = True                'afficher entetes ligne colonne

    End With

    With Application
        .DisplayFullScreen = False    'Masque plein ecran
        .DisplayFormulaBar = True    'afficher barre formule
    End With
End Sub

Merci pour ceux qui pourrait m'aider

Cordialement
 

patricktoulon

XLDnaute Barbatruc
bonjour
je ne sais plus pourquoi j'avais appellé ça GAW pour getactivewindow et SWLA pour setwindowlongA😅
je trouvais que ça faisait classe a ça faisait criser les Glands heu..pardon Grand s Cadors sur DVP

voila les fonctions pour le vb6/7 sur 32/64
VB:
'grille excel en plein ecran sans bords
'patricktoulon sur DVP 17/03/2013
'
'ajout du blocage de latouche esc
'module pour afficher la grille excel sans ruban et sans bord en plein ecran
'MAJ:11/06/2018
'ajout des api en vba7 et 64 bits pour 2010 et 2013

Option Explicit

#If VBA7 Then
    #If Win64 Then
        'api pour appliquer le nouveau style a la fenetre (userform)
        Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        'api pour appliquer le nouveau style a la fenetre (userform)
        Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    ' capture le handle de la fenetre
    Public Declare PtrSafe Function GAW Lib "user32" Alias "GetActiveWindow" () As LongPtr
    Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long

#Else '
    'Capture le handle de la fenetre
    Public Declare Function GAW Lib "user32" Alias "GetActiveWindow" () As Long
    'Api pour appliquer le nouveau style a la fenetre (userform)
    Public Declare Function SWLA Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    'Redessine la fenetre apres modification (Attention sur certaine config en 64 n'a pas d'effet)
    Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
#End If
Sub ToucheEscape(Optional dummy As Byte)
    '/// Procédure vide mais nécessaire pour le contrôle de la touche Escape (Echap) ///
    'Normal   'débloquer pour empêcher la touche ESC qui ne remet que le ruban
End Sub

Sub PleinEcran() '*Affichage plein écran
    SWLA GAW, -16, &H94080080: SWLA GAW, -20, &H0: DrawMenuBar GAW
    Application.OnKey "{ESCAPE}", "ToucheEscape"
    With ActiveWindow
        .DisplayHorizontalScrollBar = False     'Masque barre horizontal
        .DisplayVerticalScrollBar = False       'Masque barre vertical
        .DisplayWorkbookTabs = False            'Masque onglets
        .DisplayHeadings = False                'Masque entetes ligne colonne
    End With

    With Application
        .DisplayFullScreen = True               'afficher plein ecran
        .DisplayFormulaBar = False              'Masque barre formule
    End With

End Sub
Sub Normal() 'Affichage Normal
    SWLA GAW, -16, &H94CB0080: SWLA GAW, -20, &H0: DrawMenuBar GAW
    Application.OnKey "{ESCAPE}"
    With ActiveWindow
        .DisplayHorizontalScrollBar = True          'afficher barre horizontal
        .DisplayVerticalScrollBar = True            'afficher barre vertical
        .DisplayWorkbookTabs = True                 'afficher onglets
        .DisplayHeadings = True                     'afficher entetes ligne colonne
    End With

    With Application
        .DisplayFullScreen = False                  'Masque plein ecran
        .DisplayFormulaBar = True                   'afficher barre formule
    End With
End Sub

mais sache que aujourd'hui je peux proposer la même chose sans api
et donc compatible all versions
 

Discussions similaires

Statistiques des forums

Discussions
314 487
Messages
2 110 121
Membres
110 677
dernier inscrit
volare