AW: Wäre das schnell?
06.02.2010 11:01:24
Josef
Hallo Jo,
bezogen auf das gestrige Beispiel, würde das so aussehen.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub insertPicture()
Dim strPath As String
Dim rng As Range
Dim objPic As Object
Dim strFile As String, strName As String, strExt As String
strPath = "E:\Temp" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
With Sheets("Tabelle1") 'Tabellenname anpassen!
For Each rng In .Range("A1:A100") 'Bereich anpassen!
If rng <> "" Then
strFile = Dir(strPath & rng, vbNormal)
If strFile = "" Then
strName = Left(rng, InStr(1, rng, ".") - 1)
strExt = Mid(rng, InStr(1, rng, "."))
strFile = Dir(strPath & onlyNumbers(strName) & strExt, vbNormal)
End If
If strFile <> "" Then
Set objPic = .Pictures.Insert(strPath & strFile)
objPic.Top = rng.Top
objPic.Left = rng.Left + rng.Width - objPic.Width
End If
End If
Next
End With
End Sub
Function onlyNumbers(ByVal Text As String) As String
Dim objRegEx As Object
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = True
.Pattern = "\D+"
Text = .Replace(Text, "")
End With
onlyNumbers = Text
Set objRegEx = Nothing
End Function
Gruß Sepp