返回列表 上一主題 發帖

[發問] Userform 裡的 image 物件如何縮放???

[發問] Userform 裡的 image 物件如何縮放???

如題目前我的userform可以讓使用者自由縮放
但是要怎樣才能讓 image 物件也能跟著縮放???
擷取.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("管制計畫表").Range("I4").Value
  54. '    Dim imgpath As String
  55. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
  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
複製代碼
userform自縮.rar (23.32 KB)

回復 1# s13030029
隨然不太知道UserForm_Layout程式的內容是甚麼,但是拼拼湊湊還是成功了。
  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("管制計畫表").Range("I4").Value
  54. '    Dim imgpath As String
  55. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
  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
複製代碼
userform自縮.rar (25.38 KB)

TOP

有高手可以幫我看看我這樣解釋對嗎???@@
  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() '匯入圖面
  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.     'userform最大、最小化按鈕的顯示
  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.       '初始化視窗大小
  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.          '這將創建一個垂直一個水平滾動條,fmScrollBarsHorizontal顯示水平捲軸,fmScrollBarsVertical顯示垂直捲軸,fmScrollBarsBoth顯示水平與垂直捲軸兩者。
  50.         .ScrollBars = fmScrollBarsBoth
  51.         '根據您的要求更改值2
  52.         .ScrollHeight = .InsideHeight * 2
  53.         .ScrollWidth = .InsideWidth * 2
  54.     End With
  55.     '根據產品編號自動從產品圖面資料夾匯入圖面
  56.     imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
  57.     Dim imgpath As String
  58.     imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"
  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() '圖像縮小鍵
  71. Me.Image1.Height = Me.Image1.Height - 200
  72. Me.Image1.Width = Me.Image1.Width - 200
  73. End Sub

  74. Private Sub CommandButton2_Click() '圖像放大鍵
  75. Me.Image1.Height = Me.Image1.Height + 200
  76. Me.Image1.Width = Me.Image1.Width + 200
  77. End Sub

  78. Public Sub myShowMax() 'userform 最大化
  79.         SetActiveWindow hWndForm
  80.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  81. End Sub

  82. Private Sub UserForm_Layout()
  83.     '取得目前視窗大小
  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.         '最大化視窗觸發時
  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.     '計算視窗大小?????
  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.     '當縮放userform時,裡面的物件也跟著變動
  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.     '儲存目前視窗的大小
  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
複製代碼

TOP

        靜思自在 : 為人處世要小心細心,但不要「小心眼」。
返回列表 上一主題