Question

的回答

但是，我的Excel是一个初学者版本，它没有＆＃34;颜色和线条＆＃34;在＆＃34;格式注释＆＃34;

我想将我的照片放入H列。每当我点击单元格时，图片就会放大。可能的？

注意：我没有vba经验

Answer 1

您可以在想要的位置添加图片（名称图片1）。将以下代码添加到Sheet1：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Prev Then
        Dim x
        x = ActiveCell.Address
        ActiveSheet.Shapes.Range(Array("Picture 1")).Select
        Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
        Prev = False
        Range(x).Select
    End If
End Sub

并在一个模块中（在VBA中Alt + F11 - ＆gt;右键单击：Sheet1 - ＆gt;插入 - ＆gt;模块）：

Public Prev As Boolean

Sub Macro1()
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
    Prev = True
End Sub

为图片指定宏Macro1 ...（右键单击图片 - ＆gt;指定宏）
当您点击图片时图片放大，当您点击另一个单元格时，图片缩小点。

Answer 2

通过从组合框列表中选择行号将图片放到列H中，并将图片放到符合中心点的单元格中，从而节省了aspectratio

Private Sub ComboBox1_Change()
    PTstop = Me.ComboBox1.value
    PicPath = Worksheets("Sheet1").Application.GetOpenFilename("*.jpg,*.png,*.jpeg,*.gif")
                    If PicPath <> False Then
                        With .Pictures.Insert(Filename:=PicPath)
                            With .ShapeRange
                                If .Width > .Height Then
                                    If .Height >= Worksheets("Sheet1").Cells(PTstop, 8).Height Then
                                        .Height = Worksheets("Sheet1").Cells(PTstop, 8).Height
                                        If .Width >= Worksheets("Sheet1").Cells(PTstop, 8).Width Then
                                            .Width = Worksheets("Sheet1").Cells(PTstop, 8).Width 
                                        Else
                                        End If
                                    Else
                                        .Width = Worksheets("Sheet1").Cells(PTstop, 8).Width
                                        If .Height >= Worksheets("Sheet1").Cells(PTstop, 8).Height Then
                                            .Height = Worksheets("Sheet1").Cells(PTstop, 8).Height
                                        Else
                                        End If
                                    End If
                                Else
                                    .Height = Worksheets("Sheet1").Cells(PTstop , 8).Height
                                End If
                                .Top = Worksheets("Sheet1").Cells(PTstop, 8).Top + Worksheets("Sheet1").Cells(PTstop , 8).Height / 2 - .Height / 2
                                .Left = Worksheets("Sheet1").Cells(PTstop, 8).Left + Worksheets("Sheet1").Cells(PTstop, 8).Width / 2 - .Width / 2

                            End With
                        End With
                    End If
End Sub

代码放大图像然后单击图像右侧，如果单击A列中的任何位置，图像应缩小尺寸。没有作为起点进行测试。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rangeS As Range, picSelected As Shape, old
If Target.Column > 1 Then
    Set rangeS = Target.Offset(, -1)
        For Each picSelected In ActiveSheet.Shapes
            If TypeName(picSelected.OLEFormat.Object) = "Picture" Then
                If picSelected.TopLeftCell.Address = rangeS.Address Then
                    picSelected.Height = 250
                    picSelected.Width = 250
                End If
            End If
        Next picSelected
ElseIf Target.Column = 1 Then
    For Each picSelected In ActiveSheet.Shapes
       If TypeName(picSelected.OLEFormat.Object) = "Picture" Then
           With picSelected
                            If .Width > .Height Then
                                If .Height >= Target.Height Then
                                    .Height = Target.Height
                                Else
                                    .Width = Target.Width
                                    If .Height >= Target.Height Then
                                        .Height = Target.Height
                                    Else
                                    End If
                                End If
                            Else
                                .Height = Target.Height
                            End If
                            .Top = Target.Top + Target.Height / 2 - .Height / 2
                            .Left = Target.Left + Target.Width / 2 - .Width / 2

End With
       End If
   Next picSelected
End If
End Sub

如何在excel VBA中隐藏图片？

2 个答案: