返回列表 上一主題 發帖

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

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-7-26 09:18 | 只看該作者

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

如題目前我的userform可以讓使用者自由縮放
但是要怎樣才能讓 image 物件也能跟著縮放???
  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

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

  35. End Sub

  37. Private Sub UserForm_Initialize()

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


  52.     With Frame1
  53.         '~~> This will create a vertical scrollbar
  54.         .ScrollBars = fmScrollBarsBoth

  56.         '~~> Change the values of 2 as Per your requirements
  57.         .ScrollHeight = .InsideHeight * 2
  58.         .ScrollWidth = .InsideWidth * 2
  59.     End With

  61. '    imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
  62. '    Dim imgpath As String
  63. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
  64. '    With Image1
  65. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  66. '        .AutoSize = True
  67. '        .BorderStyle = fmBorderStyleNone
  68. '        .PictureSizeMode = fmPictureSizeModeZoom
  69. '    End With

  71. End Sub

  73. Private Sub CommandButton3_Click()
  74. Me.Image1.Height = Me.Image1.Height - 100
  75. Me.Image1.Width = Me.Image1.Width - 100
  76. End Sub

  78. Private Sub CommandButton2_Click()
  79. Me.Image1.Height = Me.Image1.Height + 100
  80. Me.Image1.Width = Me.Image1.Width + 100
  81. End Sub

  83. Public Sub myShowMax()
  84.         SetActiveWindow hWndForm
  85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  86.     End Sub

  88. Private Sub UserForm_Layout()

  90. ' If ocx_First_wh.Count = 0 Then
  91. '    ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  92. '    For Each s In Controls
  93. '        ocx_First_wh.Add Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  94. '    Next
  95.    
  96.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  97.     If Form_xy <> "" Then
  98.        Form_xy = Split(Form_xy + String(5, ","), ",")
  99.        If Form_xy(5) = "max" Then
  100.           myShowMax
  101.        Else
  102.           On Error Resume Next
  103.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  104.           On Error GoTo 0
  105.        End If
  106.     End If
  107.     Exit Sub
  108. ' End If
  109.    
  110. Form_xy = ocx_First_wh("UserForm")(1)
  111. Rw = Width / Form_xy(2)
  112. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  113. Rwh = IIf(Rw < Rh, Rw, Rh)

  115. For w = 2 To ocx_First_wh.Count
  116.      
  117.      Set ocx = ocx_First_wh(w)(0)
  118.       ocx_xy = ocx_First_wh(w)(1)
  119.      
  120.      ocx.Left = ocx_xy(0) * Rw
  121.       ocx.Top = ocx_xy(1) * Rh
  122.     ocx.Width = ocx_xy(2) * Rw
  123.    ocx.Height = ocx_xy(3) * Rh
  124.    If TypeOf ocx Is CommandButton Then
  125.       ocx.FontSize = ocx_xy(4) * Rwh
  126.    Else
  127.       ocx.FontSize = ocx_xy(4) * Rh
  128.    End If
  129. Next

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

  135. End Sub
複製代碼
userform自縮.rar (23.32 KB)
收藏 分享

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
2#
發表於 2019-7-26 13:12 | 只看該作者
回復 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

  25. Private Sub CommandButton1_Click()

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

  35. End Sub

  37. Private Sub UserForm_Initialize()

  39.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  40.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  41.       IStyle = IStyle Or WS_THICKFRAME
  42.       IStyle = IStyle Or WS_MINIMIZEBOX
  43.       IStyle = IStyle Or WS_MAXIMIZEBOX
  44.       SetWindowLong hWndForm, GWL_STYLE, IStyle
  45.       
  46.       a = Height
  47.       Height = 0
  48.       Fomr_TopBarHeight = Height
  49.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
  50.       Height = a + 1.5

  52.     With Frame1
  53.         '~~> This will create a vertical scrollbar
  54.         .ScrollBars = fmScrollBarsBoth

  56.         '~~> Change the values of 2 as Per your requirements
  57.         .ScrollHeight = .InsideHeight * 2
  58.         .ScrollWidth = .InsideWidth * 2
  59.     End With

  61. '    imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
  62. '    Dim imgpath As String
  63. '    imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"  '指定資料夾
  64. '    With Image1
  65. '        .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  66. '        .AutoSize = True
  67. '        .BorderStyle = fmBorderStyleNone
  68. '        .PictureSizeMode = fmPictureSizeModeZoom
  69. '    End With

  71. End Sub

  73. Private Sub CommandButton3_Click()
  74. Me.Image1.Height = Me.Image1.Height - 200
  75. Me.Image1.Width = Me.Image1.Width - 200
  76. End Sub

  78. Private Sub CommandButton2_Click()
  79. Me.Image1.Height = Me.Image1.Height + 200
  80. Me.Image1.Width = Me.Image1.Width + 200
  81. End Sub

  83. Public Sub myShowMax()
  84.         SetActiveWindow hWndForm
  85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  86. End Sub

  88. Private Sub UserForm_Layout()

  90. If ocx_First_wh.Count = 0 Then
  91.     ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  92.    
  93.     On Error Resume Next
  94.     For Each s In Controls
  95.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  96.         If Err Then
  97.         ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
  98.         End If
  99.     Next
  100.     On Error GoTo 0
  101.    
  102.        Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  103.     If Form_xy <> "" Then
  104.        Form_xy = Split(Form_xy + String(5, ","), ",")
  105.        If Form_xy(5) = "max" Then
  106.           myShowMax
  107.        Else
  108.           On Error Resume Next
  109.           Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  110.           On Error GoTo 0
  111.        End If
  112.     End If
  113.     Exit Sub
  114. End If

  116. Form_xy = ocx_First_wh("UserForm")(1)
  117. Rw = Width / Form_xy(2)
  118. Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  119. Rwh = IIf(Rw < Rh, Rw, Rh)

  121. For w = 2 To ocx_First_wh.Count
  122.      
  123.      Set ocx = ocx_First_wh(w)(0)
  124.       ocx_xy = ocx_First_wh(w)(1)
  125.      
  126.      ocx.Left = ocx_xy(0) * Rw
  127.       ocx.Top = ocx_xy(1) * Rh
  128.     ocx.Width = ocx_xy(2) * Rw
  129.    ocx.Height = ocx_xy(3) * Rh
  130.    If TypeOf ocx Is CommandButton Then
  131.       ocx.FontSize = ocx_xy(4) * Rwh
  132.    Else
  133. '      ocx.FontSize = ocx_xy(4) * Rh
  134.    End If
  135. Next

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

  141. End Sub
複製代碼
userform自縮.rar (25.38 KB)

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
3#
發表於 2019-7-26 13:59 | 只看該作者
有高手可以幫我看看我這樣解釋對嗎???@@
  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

  35. Private Sub UserForm_Initialize() '表單初始化
  36.     'userform最大、最小化按鈕的顯示
  37.       hWndForm = FindWindow("ThunderDFrame", Me.Caption)
  38.       IStyle = GetWindowLong(hWndForm, GWL_STYLE)
  39.       IStyle = IStyle Or WS_THICKFRAME
  40.       IStyle = IStyle Or WS_MINIMIZEBOX
  41.       IStyle = IStyle Or WS_MAXIMIZEBOX
  42.       SetWindowLong hWndForm, GWL_STYLE, IStyle
  43.       '初始化視窗大小
  44.       A = Height
  45.       Height = 0
  46.       Fomr_TopBarHeight = Height
  47.       Fomr_TopBarHeight = Fix(Fomr_TopBarHeight)
  48.       Height = A + 1.5

  50.     With Frame1
  51.          '這將創建一個垂直一個水平滾動條，fmScrollBarsHorizontal顯示水平捲軸，fmScrollBarsVertical顯示垂直捲軸，fmScrollBarsBoth顯示水平與垂直捲軸兩者。
  52.         .ScrollBars = fmScrollBarsBoth
  53.         '根據您的要求更改值2
  54.         .ScrollHeight = .InsideHeight * 2
  55.         .ScrollWidth = .InsideWidth * 2
  56.     End With
  57.     '根據產品編號自動從產品圖面資料夾匯入圖面
  58.     imgname = ActiveWorkbook.Sheets("管制計畫表").Range("I4").Value
  59.     Dim imgpath As String
  60.     imgpath = "\\G-server\產品履歷\客戶\00.範本\產品圖面"
  61.     With Image1
  62.         .Picture = LoadPicture(imgpath & "\" & imgname & ".jpg")
  63.         .AutoSize = True
  64.         .BorderStyle = fmBorderStyleNone
  65.         .PictureSizeMode = fmPictureSizeModeZoom
  66.     End With
  67.     With Frame1
  68.         .BorderStyle = fmBorderStyleNone
  69.         .PictureSizeMode = fmPictureSizeModeZoom
  70.     End With
  71. End Sub

  73. Private Sub CommandButton3_Click() '圖像縮小鍵
  74. Me.Image1.Height = Me.Image1.Height - 200
  75. Me.Image1.Width = Me.Image1.Width - 200
  76. End Sub

  78. Private Sub CommandButton2_Click() '圖像放大鍵
  79. Me.Image1.Height = Me.Image1.Height + 200
  80. Me.Image1.Width = Me.Image1.Width + 200
  81. End Sub

  83. Public Sub myShowMax() 'userform 最大化
  84.         SetActiveWindow hWndForm
  85.         ShowWindow hWndForm, SW_SHOWMAXIMIZED
  86. End Sub

  88. Private Sub UserForm_Layout()
  89.     '取得目前視窗大小
  90.     If ocx_First_wh.Count = 0 Then
  91.         ocx_First_wh.Add Key:="UserForm", Item:=Array(, Array(Left, Top, Width, Height, Font.Size, ""))
  92.         On Error Resume Next
  93.         For Each s In Controls
  94.             ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, s.Font.Size))
  95.             If Err Then
  96.                 ocx_First_wh.Add Key:=s.Name, Item:=Array(s, Array(s.Left, s.Top, s.Width, s.Height, Empty))
  97.             End If
  98.         Next
  99.         On Error GoTo 0
  100.         Form_xy = GetSetting(ThisWorkbook.Name, Name, "Form_Size")
  101.         '最大化視窗觸發時
  102.         If Form_xy <> "" Then
  103.            Form_xy = Split(Form_xy + String(5, ","), ",")
  104.            If Form_xy(5) = "max" Then
  105.               myShowMax
  106.            Else
  107.               On Error Resume Next
  108.               Move Form_xy(0), Form_xy(1), Form_xy(2), Form_xy(3)
  109.               On Error GoTo 0
  110.            End If
  111.         End If
  112.         Exit Sub
  113.     End If
  114.     '計算視窗大小?????
  115.     Form_xy = ocx_First_wh("UserForm")(1)
  116.     Rw = Width / Form_xy(2)
  117.     Rh = (Height - Fomr_TopBarHeight) / (Form_xy(3) - Fomr_TopBarHeight)
  118.     Rwh = IIf(Rw < Rh, Rw, Rh)
  119.     '當縮放userform時，裡面的物件也跟著變動
  120.     For w = 2 To ocx_First_wh.Count
  121.       Set ocx = ocx_First_wh(w)(0)
  122.             ocx_xy = ocx_First_wh(w)(1)
  123.             ocx.Left = ocx_xy(0) * Rw
  124.             ocx.Top = ocx_xy(1) * Rh
  125.             ocx.Width = ocx_xy(2) * Rw
  126.             ocx.Height = ocx_xy(3) * Rh
  127.         If TypeOf ocx Is CommandButton Then
  128.           ocx.FontSize = ocx_xy(4) * Rwh
  129.        Else
  130.        End If
  131.     Next
  132.     '儲存目前視窗的大小
  133.     On Error Resume Next
  134.     Height = Height
  135.     SaveSetting ThisWorkbook.Name, Name, "Form_Size", Join(Array(Left, Top, Width, Height, 0, IIf(Err, "max", "")), ",")
  136. End Sub
複製代碼

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題