时间戳

首页 > 解决方案 > 我是 VBA 新手，所以我不知道如何删除对象的文件扩展名

excel - 我是 VBA 新手，所以我不知道如何删除对象的文件扩展名

问题描述

如何删除我输入的对象的文件扩展名，所以“A”列只显示没有扩展名的文件名。

Sub AddOlEObject()
Dim mainWorkBook As Workbook

Set mainWorkBook = ActiveWorkbook
Sheets("Object").Activate
Folderpath = "C:\Users\Sumit Jain\Pictures"
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
    strCompFilePath = Folderpath & "\" & Trim(fls.Name)
    If strCompFilePath <> "" Then
        If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
        Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
        Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
        counter = counter + 1
        Sheets("Object").Range("A" & counter).Value = fls.Name
        Sheets("Object").Range("B" & counter).ColumnWidth = 25
        Sheets("Object").Range("B" & counter).RowHeight = 100
        Sheets("Object").Range("B" & counter).Activate
        Call insert(strCompFilePath, counter)
        Sheets("Object").Activate
    End If
End If
Next
mainWorkBook.Save
End Sub

Function insert(PicPath, counter)
‘MsgBox PicPath
With ActiveSheet.Pictures.insert(PicPath)
With .ShapeRange
    .LockAspectRatio = msoTrue
    .Width = 50
    .Height = 70
End With
.Left = ActiveSheet.Range("B" & counter).Left
.Top = ActiveSheet.Range("B" & counter).Top
.Placement = 1
.PrintObject = True
End With
End Function

谢谢你的帮助（对不起我的英语不好）

标签： excelvba

解决方案

使用InStrRev 函数从字符串末尾返回一个字符串在另一个字符串中出现的位置。所以我们.从字符串的右边开始查找，然后得到不带扩展名的文件名。

这是你想要的吗？

Sheets("Object").Range("A" & counter).Value = _
Left(fls.Name, (InStrRev(fls.Name, ".", -1, vbTextCompare) - 1))

推荐阅读