32 bit 64 bit tam ekran kodu uyumluluğu

M

meslek5

Katılım
19 Eylül 2012
Mesajlar
293
Excel Vers. ve Dili
2010 türkçe
Merhaba değerli hocalarım. Aşağıda yazılı kod sadece 32 bit ofiste çalışıyor ve 64 bit ofislerde hata veriyor. Bu kodu hem 32 hem de 64 bit ofis sürümlerinde kullanabilmek için nasıl bir değişiklik yapılması gerekiyor. Yardımlarınız için şimdiden teşekkür ederim.


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Dim hwnd As Long, lngRet As Long, hIcon As Long, WStyle As Long, Result As Long

Private Sub UserForm_Activate()
KucultButonuEkle
GorevCubugundaGoster Me
Application.Visible = False
End Sub

Private Sub KucultButonuEkle()
Dim hWndForm As Long, frmStyle As Long
hWndForm = FindWindow(vbNullString, Me.Caption)
frmStyle = GetWindowLong(hWndForm, (-16))
frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
SetWindowLong hWndForm, (-16), frmStyle
ShowWindow hWndForm, 5
DrawMenuBar hWndForm
End Sub

Private Sub GorevCubugundaGoster(myForm)
hwnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_HIDEWINDOW)
Result = SetWindowLong(hwnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
559
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPtr
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
#Else
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
#End If

Dim hwnd As LongPtr, lngRet As LongPtr, hIcon As LongPtr, WStyle As LongPtr, Result As LongPtr

Private Sub UserForm_Activate()
KucultButonuEkle
GorevCubugundaGoster Me
Application.Visible = False
End Sub

Private Sub KucultButonuEkle()
Dim hWndForm As LongPtr, frmStyle As LongPtr
hWndForm = FindWindow(vbNullString, Me.Caption)
frmStyle = GetWindowLongPtr(hWndForm, (-16))
frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
SetWindowLongPtr hWndForm, (-16), frmStyle
ShowWindow hWndForm, 5
DrawMenuBar hWndForm
End Sub

Private Sub GorevCubugundaGoster(myForm)
hwnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLongPtr(hwnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_HIDEWINDOW)
Result = SetWindowLongPtr(hwnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub


Bu değişikliklerle, kodunuz hem 32 hem de 64 bit ofislerde çalışacaktır.
 
M

meslek5

Katılım
19 Eylül 2012
Mesajlar
293
Excel Vers. ve Dili
2010 türkçe
muhasebeciyiz' Alıntı:
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As LongPtr
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPtr
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
#Else
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
#End If

Dim hwnd As LongPtr, lngRet As LongPtr, hIcon As LongPtr, WStyle As LongPtr, Result As LongPtr

Private Sub UserForm_Activate()
KucultButonuEkle
GorevCubugundaGoster Me
Application.Visible = False
End Sub

Private Sub KucultButonuEkle()
Dim hWndForm As LongPtr, frmStyle As LongPtr
hWndForm = FindWindow(vbNullString, Me.Caption)
frmStyle = GetWindowLongPtr(hWndForm, (-16))
frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
SetWindowLongPtr hWndForm, (-16), frmStyle
ShowWindow hWndForm, 5
DrawMenuBar hWndForm
End Sub

Private Sub GorevCubugundaGoster(myForm)
hwnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLongPtr(hwnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_HIDEWINDOW)
Result = SetWindowLongPtr(hwnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub


Bu değişikliklerle, kodunuz hem 32 hem de 64 bit ofislerde çalışacaktır.
Genişletmek için tıkla ...
çok teşekkür ederim hemen deniyorum
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst