输入编号图片自动充满表格四面分中问题！

东方胜 · 发表于 2020-3-23 15:15

本帖最后由东方胜于 2020-3-23 15:16 编辑

各位老师您好！
我的附件中的这个表，输入编号后图片只能以宽分中，但高度就超出了表格，能让图片不变形自动缩中吗？谢谢！

爱疯 · 发表于 2020-3-24 10:17

excel2010运行后，没看到1楼图片里红箭头的情况？

东方胜 · 发表于 2020-3-24 15:44

爱疯发表于 2020-3-24 10:17
excel2010运行后，没看到1楼图片里红箭头的情况？

老师您好，画红线的地方超出第一个表框了，它只以宽为准，可高就超出了！

爱疯 · 发表于 2020-3-25 11:36

Private Sub Worksheet_Change(ByVal T As Range)
Dim p, f, x
If T.Row Mod 11 <> 1 Or T.Column <> 6 Or T.Count <> 1 Or T.Value = "" Then Exit Sub
p = ThisWorkbook.Path
f = "Picture " & T.Row
Set x = Cells(T.Row, 1).MergeArea

Me.Unprotect

'1）删除
On Error Resume Next
Me.Shapes(f).Delete
On Error GoTo 0

'2）添加
With Me.Pictures.Insert(p & "\图片\" & T.Value & ".jpg")
      .Name = f
      .ShapeRange.LockAspectRatio = msoFalse
      .Left = x.Left
      .Top = x.Top
      .Height = x.Height
      .Width = x.Width
End With

Me.Protect

End Sub

图片大小自动置中2.rar (351.19 KB, 下载次数: 5)

东方胜 · 发表于 2020-3-27 15:14

爱疯发表于 2020-3-25 11:36
Private Sub Worksheet_Change(ByVal T As Range)
Dim p, f, x
If T.Row Mod 11 1 Or T.Column ...

谢谢老师，非常感谢，要是随比例，不变就好了！

爱疯 · 发表于 2020-3-27 15:53

东方胜发表于 2020-3-27 15:14
谢谢老师，非常感谢，要是随比例，不变就好了！

图片的宽高比例和图片所在区域宽高比例，要一样才行。如果不能保证这点，我就没办法了。

东方胜 · 发表于 2020-3-27 18:28

爱疯发表于 2020-3-27 15:53
图片的宽高比例和图片所在区域宽高比例，要一样才行。如果不能保证这点，我就没办法了。

爱疯老师您好，是这样的，图片不变形，如果高达到了，宽就随比例。如果宽达到了，高就随比例，四边分中就好了，谢谢老师！

东方胜 · 发表于 2020-4-2 20:17

自已顶一下！

爱疯 · 发表于 2020-4-3 10:30

本帖最后由爱疯于 2020-4-3 10:34 编辑

Private Sub Worksheet_Change(ByVal T As Range)
Dim p As String
Dim f As String
Dim Rng As Range

If T.Row Mod 11 <> 1 Or T.Column <> 6 Or T.Count <> 1 Or T.Value = "" Then Exit Sub
p = ThisWorkbook.Path & "\图片\"
f = "Picture " & T.Row
Set Rng = Cells(T.Row, 1).MergeArea
Me.Unprotect

On Error Resume Next
Me.Shapes(f).Delete
On Error GoTo 0

With Me.Pictures.Insert(p & T.Value & ".jpg")
      .Name = f
      .ShapeRange.LockAspectRatio = msoTrue
      .Left = Rng.Left
      .Top = Rng.Top

      '>>>
      '前提条件：（A:D）区域的宽，必须大于等于所有的图片宽
      .Height = Rng.Height '高度一致
      '.Width = Rng.Width    '不设置图片宽，改为右移图片
      .Left = Rng.Left + (Rng.Width - .Width) / 2 '为什么只是右移？因为满足前提条件
      '<<<

End With

Me.Protect
End Sub

图片大小自动置中3.rar (336.55 KB, 下载次数: 6)

		自动登录	找回密码
密码			注册