Code VB ปรับความละเอียดหน้าจอ Notebook

[tigerwit]

จากไฟล์แนบ
ต้องการเช็คความละเอียดของหน้าจอที่ทำงาน ว่าเหมาะสมกับไฟล์ที่ได้ออกแบบไว้หรือไม่

Code: Select all

Option Explicit
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1

Sub VerifyScreenResolution(Optional Dummy As Integer)
   
Dim x  As Long
Dim y  As Long
Dim MyMessage As String
Dim MyResponse As VbMsgBoxResult
   
    x = GetSystemMetrics(SM_CXSCREEN)
    y = GetSystemMetrics(SM_CYSCREEN)
    If x = 1366 And y = 768 Then
        Else
        MyMessage = "ความละเอียดหน้าจอของคุณคือ " & x & " X " & y & vbCrLf & " โปรแกรมนี้ " & _
ออกแบบในความละเอียดหน้าจอที่ 1366 X 768   & "ซึ่งเป็นมุมมองที่เหมาะสมกับจอภาพ ไม่ล้นจอเกินไป" & _
vbCrLf & "คุณต้องการเปลี่ยนแปลงความละเอียดหน้าจอหรือไม่"
        MyResponse = MsgBox(MyMessage, vbExclamation + vbYesNo, "ปรับแต่งความละเอียดหน้าจอ")
    End If
    If MyResponse = vbYes Then
        Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3")
    End If
End Sub

และวางใน Workbook Open

Code: Select all

Private Sub Workbook_Open()
    
    Call VerifyScreenResolution

End Sub

ต้องการเปลี่ยนให้ตรวจเช็คด้วยการ กดปุ่มเช็ค แทนการเช็คตอนเปิดไฟล์
โดยถ้าความละเอียดของหน้าจอ เท่ากับ 1366X768 ให้แจ้งว่า "ความละเอียดหน้าจอเหมาะกับการใช้งาน"
ถ้าไม่เท่ากับ 1366X768 ให้แจ้งว่าต้องปรับความละเอียดให้เป็น 1366X768 และเข้าไปหน้าการตั้งค่าความละเอียดหน้าจอ
จะต้องปรับโค๊ดอย่างไรครับ

[9KiTTi]

ผมก็กำลังหาวิธีคล้ายกันเลยครับ แต่เป็นการตรวจสอบเวอร์ชั่นของ Office ถ้าต่ำกว่าเวอร์ชั่น 2019 ไม่สามารถใช้งานได้ครับ ขอลองไปเป็นการบ้านหน่อยนะครับ

[snasui]

และวางใน Workbook Open

ลบหรือ Mark Code ใน Workbook Open เป็น Comment

เขียน Procedure แล้วกำหนดให้กับปุ่มใด ๆ โดยเรียกใช้ Procedure Call VerifyScreenResolution แทนครับ

ผมก็กำลังหาวิธีคล้ายกันเลยครับ แต่เป็นการตรวจสอบเวอร์ชั่นของ Office ถ้าต่ำกว่าเวอร์ชั่น 2019 ไม่สามารถใช้งานได้ครับ ขอลองไปเป็นการบ้านหน่อยนะครับ

การตรวจสอบ Excel Version ดูตัวอย่างที่นี่ครับ Check Excel Version

[tigerwit]

พอได้อ่านคำแนะนำ
ทำรู้เลยว่าตัวเอง ยังไม่มีหลักการคิดอย่างเป็นขั้นตอนที่ดีพอ
ขอบคุณครับ ทำได้แล้วครับ

[tigerwit]

โค๊ดนี้ เมื่อนำไปใช้กับบางเครื่อง
พอเปิดไฟล์ขึ้นมามีปัญหาดังภาพครับ

[snasui]

ปรับบรรทัดสีแดงในภาพเป็นตามด้านล่างครับ

Code: Select all

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
#End If