Macro ile Bilgisayarın kapanması

[why35]

Herkeze Merhaba ,
Çalışma sayfama eklemiş olduğum düğme ile bilgisayarı kapatmak istiyorum.
Hangi komut satırını eklemem gerekiyor
Teşekkür ederim

 

[Haluk]

Eski bir mesaj ama cevapsız kalmasın ... :mrgreen:

Aşağıdakilerin hepsi, yeni bir modülün içine yapıştırılacak ve daha sonra Windows_Kapat isimli prosedür ilgili düğme veya butonun click olayına atanacaktır.

Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Const VER_PLATFORM_WIN32_NT = 2
'
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
'
Type LUID
    LowPart As Long
    HighPart As Long
End Type
'
Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type
'
Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
'
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32" _
       (ByVal ProcessHandle As Long, _
        ByVal DesiredAccess As Long, _
        TokenHandle As Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
        (ByVal lpSystemName As String, _
         ByVal lpName As String, lpLuid As LUID) _
         As Long
Declare Function AdjustTokenPrivileges Lib "advapi32" _
        (ByVal TokenHandle As Long, _
         ByVal DisableAllPrivileges As Long, _
         NewState As TOKEN_PRIVILEGES, _
         ByVal BufferLength As Long, _
         PreviousState As TOKEN_PRIVILEGES, _
         ReturnLength As Long) As Long
Declare Function ExitWindowsEx Lib "user32" _
        (ByVal uFlags As Long, _
         ByVal dwReserved As Long) _
         As Long
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
        (ByRef lpVersionInformation As OSVERSIONINFO) _
         As Long
'
Function IsWinNT() As Boolean
    Dim myOS As OSVERSIONINFO
    myOS.dwOSVersionInfoSize = Len(myOS)
    GetVersionEx myOS
    IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'
Sub EnableShutDown()
    Dim hProc As Long
    Dim hToken As Long
    Dim mLUID As LUID
    Dim mPriv As TOKEN_PRIVILEGES
    Dim mNewPriv As TOKEN_PRIVILEGES
    hProc = GetCurrentProcess()
    OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
    LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
    mPriv.PrivilegeCount = 1
    mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    mPriv.Privileges(0).pLuid = mLUID
    AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
'
Sub Windows_Kapat()
    If IsWinNT Then EnableShutDown
    ExitWindowsEx EWX_SHUTDOWN + EWX_FORCE, 0
End Sub

 

[Mahmut Bayram]

Bu kodu da deneyiniz.
[vb:1:e6aea5fe2c]Private Sub CommandButton1_Click()
Shell "shutdown -s -f -t 0" 's =shutdown
End Sub[/vb:1:e6aea5fe2c]

 

[dennisf06]

merhaba,

Haluk bey in kodlariyla bilgisayari kapatiyorum. kapatmadan önce calisma kitabimdaki degisiklikleri kaydetmek icin kodu nasil degistirmem gerekiyor. baska alternatif daha kisa bir kod var mi. tesekkürler.

 

[ÖmerBey]

Merhaba,
Makronun başına aşağıdaki kod satırını ekleyiniz.

ThisWorkbook.Save

 

[dennisf06]

merhaba

ThisWorkbook.Save kodlarin en basina yazinca hata mesaji veriyor.

 

[ÖmerBey]

En baş derken modülün en başına mı yazdınız aceba?
Şu şekilde dener misiniz?

Sub Windows_Kapat()
    [COLOR="Red"]ThisWorkbook.Save[/COLOR]
    If IsWinNT Then EnableShutDown
    ExitWindowsEx EWX_SHUTDOWN + EWX_FORCE, 0
End Sub