根据名称自动识别图片

Benfyhu

冰冰189 发表于 2025-3-9 16:14
红线自已改为自已的文件夹地址

谢谢您的帮助。

Benfyhu

quqiyuan 发表于 2025-3-9 17:36
代码如下。。。
Sub 添加图片()
    Dim r

你好！还有两个小问题请教一下。谢谢

quqiyuan

Benfyhu 发表于 2025-3-10 11:59
你好！还有两个小问题请教一下。谢谢

这两个表示形状类型是图片的话就删除，数据验证跟这个没有关系，应该是下面那个删除内容的，会把验证都删了吧

quqiyuan

不过删除内容是不会清除数据验证的

Benfyhu

quqiyuan 发表于 2025-3-10 12:14
这两个表示形状类型是图片的话就删除，数据验证跟这个没有关系，应该是下面那个删除内容的，会把验证都删 ...

好的。谢谢！

大灰狼1976

如果图片都是色卡的话，为什么不直接设置单元格底色，只要做好名称与RGB对应关系就行了

Benfyhu

大灰狼1976 发表于 2025-3-10 15:37
如果图片都是色卡的话，为什么不直接设置单元格底色，只要做好名称与RGB对应关系就行了

谢谢！不是色卡的。只是我做一个图片例子的

Benfyhu

quqiyuan 发表于 2025-3-9 17:36
代码如下。。。
Sub 添加图片()
    Dim r

quqiyuan  你好！还有一个问题请教您！一样是自动识图片，只是条件的位置不一样，应该怎么修改

quqiyuan

Benfyhu 发表于 2025-3-11 15:12
quqiyuan  你好！还有一个问题请教您！一样是自动识图片，只是条件的位置不一样，应该怎么修改

quqiyuan

代码如下。。。
Sub添加图片2()
    Dim r
    Dim maxR%
    Dim shp As Shape
    Dim rng As Range
    Dim f$, p$
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet2")
    With sht
        p = wb.Path & "\图片\"
        f = p & .Cells(4, 2) & "-" & .Cells(5, 2) & ".jpg"
        f_exist = Dir(f)
        If f_exist <> "" Then
            Set rng1 = .[b11].MergeArea
            For Each shp In .Shapes
                If Round(shp.Top, 2) = Round(rng1.Top, 2) Then
                    shp.Delete
                End If
            Next
            Set shp = .Shapes.AddPicture(f, _
                    True, True, rng1.Left, rng1.Top, rng1.Width, rng1.Height)
            shp.Placement = xlMoveAndSize                      '锟斤拷锟斤拷应锟斤拷小
            shp.LockAspectRatio = msoFalse                     '取锟斤拷锟斤拷锟斤拷锟捷猴拷锟?
        Else
            MsgBox f & "锟斤拷锟斤拷锟节ｏ拷锟斤拷"
        End If
    End With
    Beep
End Sub