SpecialCells(xlCellTypeVisible) richtig einbinden
10.03.2017 12:08:06
Marcel
ich habe ein Makro, dass mir Thumbnails anhand einer Artikelnummer in meine Exceldatei spielt. Die Exceldatei enthält >6000 Artikel. Ich möchte jedoch nicht für alle Artikel die Bilder ziehen sondern nur für die Artikel, die aktuell sichtbar sind, d.h. die ich über verschiedene Filter ausgewählt habe.
Im Forum habe ich gefunden, dass der Befehl "SpecialCells(xlCellTypeVisible)" wohl der sein soll, der mich weiter bringt nur weiß ich nicht wo ich den einbinden muss. Kann mir hier bitte jemand helfen?
Hier der Code zum Ziehen des Bildes:
Public Sub prcInsertPicture()
' Legt das Dateiverzeichnis der Artikelbilder fest
Const strPath = "\\PFAD\" '
' Definiert die Variablen Zeile (Row), SpalteArtNr (columnartnr), SpalteNild (ColumnPic), _
_
Bildobjekt (object) und einen Index
Dim lngRow As Long
Dim lngIndex As Long
Dim ArtNr As String
Dim intColumnArtNr As Integer
Dim intColumnPic As Integer
Dim objShape As Object
Dim Dateinamen As String
Dim Verzeichnis As String
' Weist den Variablen SpalteArtNr (Column) und SpaltePic und Index Startwerte zu. In diesen _
_
Spalten wird die artikelnummer gesucht und das Bild platziert.
intColumnArtNr = 2
intColumnPic = 1
lngIndex = 27
Range("B:B").Select
Selection.NumberFormat = "0#\.####\.####"
' Löscht jedes Bild in der Arbeitsmappe
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then objShape.Delete
Next
For lngRow = 2 To 4000
ArtNr = Trim$(Cells(lngRow, intColumnArtNr).Text)
Dateinamen = Left(ArtNr, 2) & "_" & Mid(ArtNr, 4, 4) & "_" & Right(ArtNr, 4)
Verzeichnis = Left(ArtNr, 2) & "\" & Left(ArtNr, 2) & "_" & Mid(ArtNr, 4, 2) & "\"
If ArtNr "" Then
If Dir$(strPath & Verzeichnis & Dateinamen & "_100" & ".jpg", vbNormal) "" Then ' _
_
Prüft die Existenz eines Artikelbilds auf dem oben definierten Verzeichnis
Set objShape = ActiveSheet.Pictures.Insert(strPath & Verzeichnis & Dateinamen & _
_
"_100" & ".jpg") 'Fügt das Artikelbild in das aktive Tabellenblatt ein
'Definiert die Position/Ausrichtung sowie Größe des Bilds
With objShape
.Left = Cells(lngRow, intColumnPic).Left
.Top = Cells(lngRow, intColumnPic).Top
.ShapeRange.Width = Cells(lngRow, intColumnPic).Height - 10
End With
ElseIf Dir$(strPath & Verzeichnis & Dateinamen & ".jpg", vbNormal) "" Then ' Prü _
_
ft die Existenz eines Artikelbilds auf dem oben definierten Verzeichnis
Set objShape = ActiveSheet.Pictures.Insert(strPath & Verzeichnis & Dateinamen & _
_
".jpg") 'Fügt das Artikelbild in das aktive Tabellenblatt ein
'Definiert die Position/Ausrichtung sowie Größe des Bilds
With objShape
.Left = Cells(lngRow, intColumnPic).Left
.Top = Cells(lngRow, intColumnPic).Top
.ShapeRange.Width = Cells(lngRow, intColumnPic).Width
End With
End If
End If
Next
Set objShape = Nothing
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then
objShape.OnAction = "Bild_aendern"
End If
Next
End Sub
Danke und Grüße