ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] Userform ¸Ìªº image ª«¥ó¦p¦óÁY©ñ???

[µo°Ý] Userform ¸Ìªº image ª«¥ó¦p¦óÁY©ñ???

¦pÃD¥Ø«e§Úªºuserform¥i¥HÅý¨Ï¥ÎªÌ¦Û¥ÑÁY©ñ
¦ý¬O­n«ç¼Ë¤~¯àÅý image ª«¥ó¤]¯à¸òµÛÁY©ñ???
Â^¨ú.JPG
2019-7-26 09:16
  1. Dim ocx_First_wh As New Collection
  2. Dim Fomr_TopBarHeight
  3.    
  4.     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
  5.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  6.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
  7.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  8.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  9.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  10.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  11.     Private Const WS_MAXIMIZEBOX = &H10000
  12.     Private Const WS_MINIMIZEBOX = &H20000
  13.     Private Const GWL_STYLE = (-16)
  14.     Private Const SW_SHOWMAXIMIZED = 3
  15.     Private Const SW_SHOWNORMAL = 1
  16.     Private Const SW_SHOWMINIMIZED = 2
  17.     Private Const WS_THICKFRAME = &H40000
  18.     Const SM_CXFULLSCREEN = 16
  19.     Const SM_CYFULLSCREEN = 17
  20.     Const HWND_TOPMOST = -1
  21.     Const SWP_SHOWWINDOW = &H40
  22.     Dim hWndForm As Long
  23.     Dim IStyle As Long

  24. Private Sub CommandButton1_Click()
  25.    
  26.     With Application.FileDialog(msoFileDialogFilePicker)
  27.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
  28.         .AllowMultiSelect = False
  29.         If .Show = -1 Then
  30.             Image1.Picture = LoadPicture(.SelectedItems(1))
  31.         End If
  32.     End With

  33. End Sub

  34. Private Sub UserForm_Initialize()

  35.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  36.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  37.       IStyle = IStyle Or WS_THICKFRAME
  38.       IStyle = IStyle Or WS_MINIMIZEBOX
  39.       IStyle = IStyle Or WS_MAXIMIZEBOX
  40.       SetWindowLong hWndForm, GWL_STYLE, IStyle
  41.       a = Height
  42.       Height = 0
  43.       Fomr_TopBarHeight = Height
  44.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
  45.       Height = a + 1.5


  46.     With Frame1
  47.         '~~> This will create a vertical scrollbar
  48.         .ScrollBars = fmScrollBarsBoth

  49.         '~~> Change the values of 2 as Per your requirements
  50.         .ScrollHeight = .InsideHeight * 2
  51.         .ScrollWidth = .InsideWidth * 2
  52.     End With

  53. '    imgname = ActiveWorkbook.Sheets("ºÞ¨î­pµeªí").Range("I4").Value
  54. '    Dim imgpath As String
  55. '    imgpath = "\\G-server\²£«~¼i¾ú\«È¤á\00.½d¥»\²£«~¹Ï­±"  '«ü©w¸ê®Æ§¨
  56. '    With Image1
  57. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  58. '        .AutoSize = True
  59. '        .BorderStyle = fmBorderStyleNone
  60. '        .PictureSizeMode = fmPictureSizeModeZoom
  61. '    End With

  62. End Sub

  63. Private Sub CommandButton3_Click()
  64. Me.Image1.Height = Me.Image1.Height - 100
  65. Me.Image1.Width = Me.Image1.Width - 100
  66. End Sub

  67. Private Sub CommandButton2_Click()
  68. Me.Image1.Height = Me.Image1.Height + 100
  69. Me.Image1.Width = Me.Image1.Width + 100
  70. End Sub

  71. Public Sub myShowMax()
  72.         SetActiveWindow hWndForm
  73.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  74.     End Sub

  75. Private Sub UserForm_Layout()

  76. ' If ocx_First_wh.Count = 0 Then
  77. '    ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  78. '    For Each s In Controls
  79. '        ocx_First_wh.Add Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  80. '    Next
  81.    
  82.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  83.     If Form_xy <> "" Then
  84.        Form_xy = Split(Form_xy + String(5, ","), ",")
  85.        If Form_xy(5) = "max" Then
  86.           myShowMax
  87.        Else
  88.           On Error Resume Next
  89.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  90.           On Error GoTo 0
  91.        End If
  92.     End If
  93.     Exit Sub
  94. ' End If
  95.    
  96. Form_xy = ocx_First_wh("UserForm")(1)
  97. Rw = Width / Form_xy(2)
  98. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  99. Rwh = IIf(Rw < Rh, Rw, Rh)

  100. For w = 2 To ocx_First_wh.Count
  101.      
  102.      Set ocx = ocx_First_wh(w)(0)
  103.       ocx_xy = ocx_First_wh(w)(1)
  104.      
  105.      ocx.Left = ocx_xy(0) * Rw
  106.       ocx.Top = ocx_xy(1) * Rh
  107.     ocx.Width = ocx_xy(2) * Rw
  108.    ocx.Height = ocx_xy(3) * Rh
  109.    If TypeOf ocx Is CommandButton Then
  110.       ocx.FontSize = ocx_xy(4) * Rwh
  111.    Else
  112.       ocx.FontSize = ocx_xy(4) * Rh
  113.    End If
  114. Next

  115. On Error Resume Next
  116. Height = Height
  117. SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")

  118. End Sub
½Æ»s¥N½X
userform¦ÛÁY.rar (23.32 KB)

¦³°ª¤â¥i¥HÀ°§Ú¬Ý¬Ý§Ú³o¼Ë¸ÑÄÀ¹ï¶Ü???@@
  1.     Dim ocx_First_wh As New Collection
  2.     Dim Fomr_TopBarHeight
  3.     Dim hWndForm As Long
  4.     Dim IStyle As Long
  5.    
  6.     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
  7.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  8.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
  9.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  10.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  11.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  12.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  13.     Private Const WS_MAXIMIZEBOX = &H10000
  14.     Private Const WS_MINIMIZEBOX = &H20000
  15.     Private Const GWL_STYLE = (-16)
  16.     Private Const SW_SHOWMAXIMIZED = 3
  17.     Private Const SW_SHOWNORMAL = 1
  18.     Private Const SW_SHOWMINIMIZED = 2
  19.     Private Const WS_THICKFRAME = &H40000
  20.     Const SM_CXFULLSCREEN = 16
  21.     Const SM_CYFULLSCREEN = 17
  22.     Const HWND_TOPMOST = -1
  23.     Const SWP_SHOWWINDOW = &H40
  24.    
  25. Private Sub CommandButton1_Click() '¶×¤J¹Ï­±
  26.     With Application.FileDialog(msoFileDialogFilePicker)
  27.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
  28.         .AllowMultiSelect = False
  29.         If .Show = -1 Then
  30.             Image1.Picture = LoadPicture(.SelectedItems(1))
  31.         End If
  32.     End With
  33. End Sub

  34. Private Sub UserForm_Initialize() 'ªí³æªì©l¤Æ
  35.     'userform³Ì¤j¡B³Ì¤p¤Æ«ö¶sªºÅã¥Ü
  36.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  37.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  38.       IStyle = IStyle Or WS_THICKFRAME
  39.       IStyle = IStyle Or WS_MINIMIZEBOX
  40.       IStyle = IStyle Or WS_MAXIMIZEBOX
  41.       SetWindowLong hWndForm, GWL_STYLE, IStyle
  42.       'ªì©l¤Æµøµ¡¤j¤p
  43.       A = Height
  44.       Height = 0
  45.       Fomr_TopBarHeight = Height
  46.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
  47.       Height = A + 1.5

  48.     With Frame1
  49.          '³o±N³Ð«Ø¤@­Ó««ª½¤@­Ó¤ô¥­ºu°Ê±ø¡AfmScrollBarsHorizontalÅã¥Ü¤ô¥­±²¶b¡AfmScrollBarsVerticalÅã¥Ü««ª½±²¶b¡AfmScrollBarsBothÅã¥Ü¤ô¥­»P««ª½±²¶b¨âªÌ¡C
  50.         .ScrollBars = fmScrollBarsBoth
  51.         '®Ú¾Ú±zªº­n¨D§ó§ï­È2
  52.         .ScrollHeight = .InsideHeight * 2
  53.         .ScrollWidth = .InsideWidth * 2
  54.     End With
  55.     '®Ú¾Ú²£«~½s¸¹¦Û°Ê±q²£«~¹Ï­±¸ê®Æ§¨¶×¤J¹Ï­±
  56.     imgname = ActiveWorkbook.Sheets("ºÞ¨î­pµeªí").Range("I4").Value
  57.     Dim imgpath As String
  58.     imgpath = "\\G-server\²£«~¼i¾ú\«È¤á\00.½d¥»\²£«~¹Ï­±"
  59.     With Image1
  60.         .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  61.         .AutoSize = True
  62.         .BorderStyle = fmBorderStyleNone
  63.         .PictureSizeMode = fmPictureSizeModeZoom
  64.     End With
  65.     With Frame1
  66.         .BorderStyle = fmBorderStyleNone
  67.         .PictureSizeMode = fmPictureSizeModeZoom
  68.     End With
  69. End Sub

  70. Private Sub CommandButton3_Click() '¹Ï¹³ÁY¤pÁä
  71. Me.Image1.Height = Me.Image1.Height - 200
  72. Me.Image1.Width = Me.Image1.Width - 200
  73. End Sub

  74. Private Sub CommandButton2_Click() '¹Ï¹³©ñ¤jÁä
  75. Me.Image1.Height = Me.Image1.Height + 200
  76. Me.Image1.Width = Me.Image1.Width + 200
  77. End Sub

  78. Public Sub myShowMax() 'userform ³Ì¤j¤Æ
  79.         SetActiveWindow hWndForm
  80.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  81. End Sub

  82. Private Sub UserForm_Layout()
  83.     '¨ú±o¥Ø«eµøµ¡¤j¤p
  84.     If ocx_First_wh.Count = 0 Then
  85.         ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  86.         On Error Resume Next
  87.         For Each s In Controls
  88.             ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  89.             If Err Then
  90.                 ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
  91.             End If
  92.         Next
  93.         On Error GoTo 0
  94.         Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  95.         '³Ì¤j¤Æµøµ¡Ä²µo®É
  96.         If Form_xy <> "" Then
  97.            Form_xy = Split(Form_xy + String(5, ","), ",")
  98.            If Form_xy(5) = "max" Then
  99.               myShowMax
  100.            Else
  101.               On Error Resume Next
  102.               Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  103.               On Error GoTo 0
  104.            End If
  105.         End If
  106.         Exit Sub
  107.     End If
  108.     '­pºâµøµ¡¤j¤p?????
  109.     Form_xy = ocx_First_wh("UserForm")(1)
  110.     Rw = Width / Form_xy(2)
  111.     Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  112.     Rwh = IIf(Rw < Rh, Rw, Rh)
  113.     '·íÁY©ñuserform®É¡A¸Ì­±ªºª«¥ó¤]¸òµÛÅÜ°Ê
  114.     For w = 2 To ocx_First_wh.Count
  115.       Set ocx = ocx_First_wh(w)(0)
  116.             ocx_xy = ocx_First_wh(w)(1)
  117.             ocx.Left = ocx_xy(0) * Rw
  118.             ocx.Top = ocx_xy(1) * Rh
  119.             ocx.Width = ocx_xy(2) * Rw
  120.             ocx.Height = ocx_xy(3) * Rh
  121.         If TypeOf ocx Is CommandButton Then
  122.           ocx.FontSize = ocx_xy(4) * Rwh
  123.        Else
  124.        End If
  125.     Next
  126.     'Àx¦s¥Ø«eµøµ¡ªº¤j¤p
  127.     On Error Resume Next
  128.     Height = Height
  129.     SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")
  130. End Sub
½Æ»s¥N½X

TOP

¦^´_ 1# s13030029
ÀHµM¤£¤Óª¾¹DUserForm_Layoutµ{¦¡ªº¤º®e¬O¬Æ»ò¡A¦ý¬O«÷«÷´ê´êÁÙ¬O¦¨¥\¤F¡C
  1.     Dim ocx_First_wh As New Collection
  2.     Dim Fomr_TopBarHeight
  3.    
  4.     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
  5.     Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  6.     Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
  7.     Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  8.     Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  9.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  10.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  11.     Private Const WS_MAXIMIZEBOX = &H10000
  12.     Private Const WS_MINIMIZEBOX = &H20000
  13.     Private Const GWL_STYLE = (-16)
  14.     Private Const SW_SHOWMAXIMIZED = 3
  15.     Private Const SW_SHOWNORMAL = 1
  16.     Private Const SW_SHOWMINIMIZED = 2
  17.     Private Const WS_THICKFRAME = &H40000
  18.     Const SM_CXFULLSCREEN = 16
  19.     Const SM_CYFULLSCREEN = 17
  20.     Const HWND_TOPMOST = -1
  21.     Const SWP_SHOWWINDOW = &H40
  22.     Dim hWndForm As Long
  23.     Dim IStyle As Long

  24. Private Sub CommandButton1_Click()

  25.     With Application.FileDialog(msoFileDialogFilePicker)
  26.         .Filters.Add "ImageFile", "*.jpg; *.jpeg; *.mp4", 1
  27.         .AllowMultiSelect = False
  28.         If .Show = -1 Then
  29.             Image1.Picture = LoadPicture(.SelectedItems(1))
  30.         End If
  31.     End With

  32. End Sub

  33. Private Sub UserForm_Initialize()

  34.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  35.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  36.       IStyle = IStyle Or WS_THICKFRAME
  37.       IStyle = IStyle Or WS_MINIMIZEBOX
  38.       IStyle = IStyle Or WS_MAXIMIZEBOX
  39.       SetWindowLong hWndForm, GWL_STYLE, IStyle
  40.       
  41.       a = Height
  42.       Height = 0
  43.       Fomr_TopBarHeight = Height
  44.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
  45.       Height = a + 1.5

  46.     With Frame1
  47.         '~~> This will create a vertical scrollbar
  48.         .ScrollBars = fmScrollBarsBoth

  49.         '~~> Change the values of 2 as Per your requirements
  50.         .ScrollHeight = .InsideHeight * 2
  51.         .ScrollWidth = .InsideWidth * 2
  52.     End With

  53. '    imgname = ActiveWorkbook.Sheets("ºÞ¨î­pµeªí").Range("I4").Value
  54. '    Dim imgpath As String
  55. '    imgpath = "\\G-server\²£«~¼i¾ú\«È¤á\00.½d¥»\²£«~¹Ï­±"  '«ü©w¸ê®Æ§¨
  56. '    With Image1
  57. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  58. '        .AutoSize = True
  59. '        .BorderStyle = fmBorderStyleNone
  60. '        .PictureSizeMode = fmPictureSizeModeZoom
  61. '    End With

  62. End Sub

  63. Private Sub CommandButton3_Click()
  64. Me.Image1.Height = Me.Image1.Height - 200
  65. Me.Image1.Width = Me.Image1.Width - 200
  66. End Sub

  67. Private Sub CommandButton2_Click()
  68. Me.Image1.Height = Me.Image1.Height + 200
  69. Me.Image1.Width = Me.Image1.Width + 200
  70. End Sub

  71. Public Sub myShowMax()
  72.         SetActiveWindow hWndForm
  73.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  74. End Sub

  75. Private Sub UserForm_Layout()

  76. If ocx_First_wh.Count = 0 Then
  77.     ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  78.    
  79.     On Error Resume Next
  80.     For Each s In Controls
  81.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  82.         If Err Then
  83.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
  84.         End If
  85.     Next
  86.     On Error GoTo 0
  87.    
  88.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  89.     If Form_xy <> "" Then
  90.        Form_xy = Split(Form_xy + String(5, ","), ",")
  91.        If Form_xy(5) = "max" Then
  92.           myShowMax
  93.        Else
  94.           On Error Resume Next
  95.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  96.           On Error GoTo 0
  97.        End If
  98.     End If
  99.     Exit Sub
  100. End If

  101. Form_xy = ocx_First_wh("UserForm")(1)
  102. Rw = Width / Form_xy(2)
  103. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  104. Rwh = IIf(Rw < Rh, Rw, Rh)

  105. For w = 2 To ocx_First_wh.Count
  106.      
  107.      Set ocx = ocx_First_wh(w)(0)
  108.       ocx_xy = ocx_First_wh(w)(1)
  109.      
  110.      ocx.Left = ocx_xy(0) * Rw
  111.       ocx.Top = ocx_xy(1) * Rh
  112.     ocx.Width = ocx_xy(2) * Rw
  113.    ocx.Height = ocx_xy(3) * Rh
  114.    If TypeOf ocx Is CommandButton Then
  115.       ocx.FontSize = ocx_xy(4) * Rwh
  116.    Else
  117. '      ocx.FontSize = ocx_xy(4) * Rh
  118.    End If
  119. Next

  120. On Error Resume Next
  121. Height = Height
  122. SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")

  123. End Sub
½Æ»s¥N½X
userform¦ÛÁY.rar (25.38 KB)

TOP

        ÀR«ä¦Û¦b : ÀR§¤±`®¦¤v¹L¡B¶¢½Í²ö½×¤H«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD