排除具有特定名称的图像

我有一个VBA代码，它可以根据列A中的单元格值在Excel文件中提取图像和插入。但是在我的P驱动器中，从其中取出图像的位置，我有以“-TH”结尾的图像，我想排除它们。 即我在P驱动器中有图像，命名为“CITY-B”，另一个图像为“CITY-B-TH”。 而当我input“城市”（这是我需要在Excel中input的名称），我想它插入没有“TH”。 我怎样才能做到这一点？

Private Sub Worksheet_Change(ByVal Target As Range) If (Split(Target.Address, "$")(1) <> "A") Then Exit Sub Call Inser_Image(Target) End Sub Private Sub Inser_Image(Ac_Cells As Range) Dim myRng As Range Dim Mycell As Range Dim St As String Dim myPath As String Dim My_Pic As Shape Dim My_File As String Dim Ac_cell As Range myPath = Sheet1.Cells(1, 5).Value If Len(myPath) > 3 Then If Right(myPath, 1) <> "\" Then myPath = myPath + "\" End If End If For Each Ac_cell In Ac_Cells For Each My_Pic In Sheet1.Shapes If My_Pic.Left = Ac_cell.Offset(0, 1).Left And My_Pic.Top = Ac_cell.Offset(0, 1).Top Then My_Pic.Delete Exit For End If Next St = Trim(Ac_cell.Value) If Len(St) > 4 Then If LCase(Left(St, 4)) = "http" Then Call Insert_Picture(St, Ac_cell.Offset(0, 1)) GoTo Nextse1 End If End If myPath = "P:\" If Right(myPath, 1) <> "\" Then myPath = myPath + "\" If Not (Dir(myPath + St)) = "" Then My_File = St Else My_File = Find_File(myPath, St) End If If My_File > " " Then Call Insert_Picture(myPath + My_File, Ac_cell.Offset(0, 1)) End If Application.ScreenUpdating = True Nextse1: Next End Sub Sub Insert_Picture(thePath As String, theRange As Range) On Error GoTo Err3 Dim myPict As Shape Sheet1.Shapes.AddPicture thePath, True, True, theRange.Left, theRange.Top, theRange.Width, theRange.Height Set myPict = Sheet1.Shapes(Sheet1.Shapes.Count) With myPict .LockAspectRatio = msoFalse .Placement = xlMoveAndSize End With Set myPict = Nothing Exit Sub Err3: MsgBox Err.Description End Sub Function Find_File(thePath As String, F_N As String) As String file = Dir(thePath) Do Until file = "" If Len(file) < Len(F_N) Then GoTo EXT_N1 If LCase(Left(file, Len(F_N))) = LCase(F_N) Then Find_File = file Exit Function End If EXT_N1: file = Dir() Loop Find_File = "" End Function 

Answer 1

将EndsWith函数放在代码中。 （我包括一个开始，如果它有帮助的道路），并使用它是这样的：

  If My_File > " " Then If EndsWith(My_File,"-TH") Then else Call Insert_Picture(myPath + My_File, Ac_cell.Offset(0, 1)) End If End If 

---

  Public Function EndsWith(str As String, ending As String) As Boolean Dim endingLen As Integer endingLen = Len(ending) EndsWith = (Right(Trim(UCase(str)), endingLen) = UCase(ending)) End Function Public Function StartsWith(str As String, start As String) As Boolean Dim startLen As Integer startLen = Len(start) StartsWith = (Left(Trim(UCase(str)), startLen) = UCase(start)) End Function 

Answer 2

使用InStr在文件名中search模式“-TH”

 Dim pos As Integer pos = InStr("find the comma, in the string", ",")