Insert a picture from another worksheet

[sparky2205]

Hi folks,
I've inherited a spreadsheet that now requires changes.
The spreadsheet has a macro to update Pictograms based on a description that is populated earlier in the code.
Currently it is set up to populate the pictograms from a network location. I want to change this so that the pictograms are instead stored within the spreadsheet on a tab called "Pictograms".
Apologies for variable names in advance as the original spreadsheet is German.

What I currently have:

Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png")

BILD is declared as a Picture
ADRESSE is a String to hold the network address
BEZEICHNUNG is a string to hold the picture name (i.e.pictogram name)

What I'm trying to achieve:

Set BILD = ActiveSheet.Pictures.Insert(Worksheets("Pictograms").shapes(BEZEICHNUNG)

This is in a loop which updates BEZEICHNUNG each time through the loop and inserts the appropriate picture.

This is producing a compile error: Expected: list separator or )

 

[GWteB]

Would recommend not to use Sheet.Pictures.Insert, since this method does not embed your pictures, just the file links are added.
At some point you then might end up with a message on your worksheet like "The linked image cannot be displayed."
Perhaps this might be a better alternative.

Public Sub sparky2205()
    Dim BILD        As Shape
    Dim ADRESSE     As String
    
    Set BILD = GetPicToSheet(ADRESSE, ThisWorkbook.Worksheets("Pictograms"))
End Sub


Public Function GetPicToSheet(ByVal argPicFullName As String, ByVal argSheet As Worksheet) As Shape
    
    Dim img As Shape
    
    If Len(argPicFullName) > 0 Then
        On Error Resume Next
        Set img = argSheet.Shapes.AddPicture(FileName:=argPicFullName, LinkToFile:=False, SaveWithDocument:=True, _
                                             Left:=1, Top:=1, Width:=-1, Height:=-1)
        On Error GoTo 0
        If Not img Is Nothing Then
            With img
                .Placement = 1
                .DrawingObject.PrintObject = True
            End With
            Set GetPicToSheet = img
        End If
    End If
End Function

 

[sparky2205]

Hi, thanks for the reply.
I'm struggling to incorporate your solution into the code I have. As I said I inherited this.
So I'm just going to post the whole thing here. Apologies again for the German throughout. I've translated as much as possible.
You will see a few attempts at ADRESSE. This is ultimately what I'm trying to achieve i.e. change from getting the pictograms from the network to having them in a worksheet in the workbook.

Function GEFAHRSTOFFSYMBOL() ' hazardous substance symbol

      Dim ZEILE As Variant 'ROW
      Dim ZEILE_ANFANG As Variant 'LINE_START
      Dim ZEILE_ENDE As Variant 'LINE_END
      Dim COLUMN As Variant
      Dim FIRST_COLUMN As Variant
      Dim LAST_COLUMN As Variant
      Dim FELD As Variant 'FIELD
      Dim ZAEHLER As Variant 'COUNTER
      Dim HOEHE As Variant 'HEIGHT
      Dim BRENNBAR As Variant 'FLAMMABLE
      Dim EXPLOSIV As Variant 'EXPLOSIVE
      Dim AETZEND As Variant 'CORRISIVE
      Dim GIFTIG As Variant 'POISONOUS
      Dim GESUNDHEITSSCHAEDLICH As Variant 'HARMFUL
                  
      Dim BILD As Picture 'IMAGE
      
      Dim GHS1 As String
      Dim GHS2 As String
      Dim GHS3 As String
      Dim GHS4 As String
      Dim GHS5 As String
      Dim GHS6 As String
      Dim GHS7 As String
      Dim GHS8 As String
      Dim GHS9 As String
      Dim TEXT As String
      Dim BEZEICHNUNG As String 'DESCRIPTION
      Dim ADRESSE As String 'ADDRESS
      'Dim H_SAETZE As Integer 'H_PHRASE
      Dim GHS_NUMMERN As String 'GHS_NUMBERS
      Dim GHS_SYMBOLE As String 'GHS_SYMBOL
      
      
      'Hier kommt der Definitionsteil, in dem alle Parameter eingestellt werden
      'Here comes the definition part, in which all parameters are set
      '************************************************************************
            
      ZEILE_ANFANG = 5 'Ab welcher Zele sollen die GHS-Symbole eingesetzt werden --- From which row should the GHS symbols be used
      ZEILE_ENDE = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
      'ZEILE_ENDE = 100 'Bis zu welcher Zele sollen die GHS-Symbole eingesetzt werden --- Up to which line should the GHS symbols be used
      FIRST_COLUMN = 10
      LAST_COLUMN = 17
      'H_SAETZE = 14 'In welcher Spalte stehen die H-Sätze --- In which column are the H_Phrases
      GHS_NUMMERN = "I" 'In welche Spalte sollen die GHS-Nummern eingefügt werden --- In which column should the GHS numbers be inserted
      ADRESSE = "Pictograms"  'In welchem Ordner liegen die GHS-Symbole --- In which folder are the GSH Symbols located
      'ADRESSE = "K:\QUALITY\Hazard Symbols\"
      HOEHE = 29 'Wie hoch sollen die GHS-Symbole sein --- How high should the GHS symbols be
      GHS_SYMBOLE = "H" 'In welche Spalte sollen die GHS-Symbole eingesetzt werden --- In which column should the GHS symbols be placed
      
      '************************************************************************
      'Hier endet der Definitionsteil, in dem alle Parameter eingestellt werden
      'This is where the definition section ends, in which all parameters are set
      
      
      'Folgende Ausschlussbedingungen gibt es:
      'There are the following exclusion conditions:
      '************************************************************************
      
      'a) Wenn GHS01 dann kein GHS02 und GHS03 --- IF GHS01 THEN NO GHS02 AND GHS03
      'b) Wenn GHS06 dann kein GHS07 --- IF GHS06 THEN NO GHS07
      'c) Wenn GHS05 und H315 oder H319 dann kein GHS07 --- IF GHS05 AND H315 OR H319 THEN NO GHS07
      'd) WENN GHS08 und H315 oder H317 oder H319 dann kein GHS07 --- IF GHS08 AND H315 OR H317 OR H319 THEN NO GHS07
      'e) Wenn GHS02 oder GHS06 dann kein GHS04 --- IF GHS02 OR GHS06 THEN NO GHS04
      
      '************************************************************************
      'Hier endet die Beschreibung der Ausschlussbedingungen
      'The description of the exclusion conditions ends here
      
      
      For Each wks In ActiveWorkbook.Worksheets 'Folgende Routine setzt alle Filterungen zurück, da sonst das Programm nicht richtig funktioniert --- The following routine removes all filters, otherwise the program will not work properly
            With wks
                  If .FilterMode Then .ShowAllData
            End With
      Next wks
      
      ActiveSheet.Pictures.Delete 'Bei jedem Programmaufruf werden alle Bilder erst einmal gelöscht, sonst würden immer mehr Bilder übereinander abgelegt --- Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
      ActiveSheet.Range("I5:I100").ClearContents
      
      Columns(GHS_SYMBOLE).ColumnWidth = HOEHE 'HEIGHT
      
      For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'FOR ROW = ROW_START TO ROW_END
      
        For COLUMN = FIRST_COLUMN To LAST_COLUMN - 1
                  
            GHS1 = ""
            GHS2 = ""
            GHS3 = ""
            GHS4 = ""
            GHS5 = ""
            GHS6 = ""
            GHS7 = ""
            GHS8 = ""
            GHS9 = ""
      
            'TEXT = Range(H_SAETZE & ZEILE) ' RANGE(H_PHRASE & ROW)
            TEXT = Cells(ZEILE, COLUMN).Value
            'TEXT = Cells(4, 14).Value
            BRENNBAR = 0 ' FLAMMABLE
            EXPLOSIV = 0 ' EXPLOSIVE
            AETZEND = 0 ' CORROSIVE
            GIFTIG = 0 ' POISONOUS
            GESUNDHEITSSCHAEDLICH = 0 ' HARMFUL
            
            If InStr(TEXT, "200") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "201") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "202") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "203") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "204") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "240") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "241") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
            
            If EXPLOSIV = 0 Then
            
                  If InStr(TEXT, "220") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1 ' FLAMMABLE
                  
                  End If
                  
                  If InStr(TEXT, "222") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "223") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "224") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "225") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "226") Then
            
                        GHS2 = "Picture 2, "
                  
                  End If
                  
                  If InStr(TEXT, "228") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "241") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "242") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "250") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "251") Then
            
                        GHS2 = "Picture 2, "
                  
                  End If
                  
                  If InStr(TEXT, "252") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "260") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "261") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "270") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
                  
                  If InStr(TEXT, "271") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
                  
                  If InStr(TEXT, "272") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
            
            End If
            
            If InStr(TEXT, "300") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1 ' POISONOUS
                  
            End If
                  
            If InStr(TEXT, "301") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "310") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "311") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "330") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "331") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
            
            If BRENNBAR = 0 Then
            
                  If GIFTIG = 0 Then
            
                        If InStr(TEXT, "280") Then
            
                              GHS4 = "Picture 4, "
                  
                        End If
                  
                        If InStr(TEXT, "281") Then
            
                              GHS4 = "Picture 4, "
                  
                        End If
            
                  End If
            
            End If
                              
            If InStr(TEXT, "290") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1 ' CORROSIVE
                  
            End If
                  
            If InStr(TEXT, "314") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1
                  
            End If
                  
            If InStr(TEXT, "318") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1
                  
            End If
                  
            If InStr(TEXT, "334") Then
            
                  GHS8 = "Picture 8, "
                  GESUNDHEITSSCHAEDLICH = 1 ' HARMFUL
                  
            End If
                  
            If InStr(TEXT, "340") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "341") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "350") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "351") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "360") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "361") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "370") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "371") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "372") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "373") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "304") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
            
            If GIFTIG = 0 Then
            
                  If InStr(TEXT, "302") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "312") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "332") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If AETZEND = 0 Then
                  
                        If GESUNDHEITSSCHAEDLICH = 0 Then
                  
                              If InStr(TEXT, "315") Then
            
                                  GHS7 = "Picture 7, "
                  
                              End If
                  
                              If InStr(TEXT, "319") Then
            
                                  GHS7 = "Picture 7, "
                  
                              End If
                  
                        End If
                  
                  End If
                  
                  If GESUNDHEITSSCHAEDLICH = 0 Then
                  
                        If InStr(TEXT, "317") Then
            
                            GHS7 = "Picture 7, "
                  
                        End If
                  
                  End If
                  
                  If InStr(TEXT, "335") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "336") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "420") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
            
            End If
                            
            If InStr(TEXT, "400") Then
            
                  GHS9 = "Picture 9, "
                  
            End If
                  
            If InStr(TEXT, "410") Then
            
                  GHS9 = "Picture 9, "
                  
            End If
                  
            If InStr(TEXT, "411") Then
            
                  GHS9 = "Picture 9, "
            
            End If
            
            Range(GHS_NUMMERN & ZEILE) = Range(GHS_NUMMERN & ZEILE) + GHS1 + GHS2 + GHS3 + GHS4 + GHS5 + GHS6 + GHS7 + GHS8 + GHS9 ' GHS_NUMBERS & ROW)
            'TEXT = Range(GHS_NUMMERN & ZEILE).Value
                 
        Next
      
      Next
            
      For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'Jede Zeile wird überprüft --- Every line is checked
      
            TEXT = Range(GHS_NUMMERN & ZEILE)
            ZAEHLER = 0

            For FELD = 1 To 9 'Jedes Gefahrensymbol wird gesucht --- Every danger symbol is searched for
                  
                  Select Case FELD ' FIELD
                  
                        Case Is = 1
                              BEZEICHNUNG = "Picture 1" '"GHS01" ' DESCRIPTION
                  
                        Case Is = 2
                              BEZEICHNUNG = "Picture 2" '"GHS02"
                  
                        Case Is = 3
                              BEZEICHNUNG = "Picture 3" '"GHS03"
                  
                        Case Is = 4
                              BEZEICHNUNG = "Picture 4" '"GHS04"
                  
                        Case Is = 5
                              BEZEICHNUNG = "Picture 5" '"GHS05"
                  
                        Case Is = 6
                              BEZEICHNUNG = "Picture 6" '"GHS06"
                  
                        Case Is = 7
                              BEZEICHNUNG = "Picture 7" '"GHS07"
                  
                        Case Is = 8
                              BEZEICHNUNG = "Picture 8" '"GHS08"
                  
                        Case Is = 9
                              BEZEICHNUNG = "Picture 9" '"GHS09"
                  
                        End Select
                  
                  If InStr(TEXT, BEZEICHNUNG) Then
                                                                                 
                        'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
                        Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)
                              With BILD 'Das Bild wird eingefügt --- The picture is inserted
                                    .ShapeRange.LockAspectRatio = msoFalse
                                    .Height = HOEHE
                                    .Width = HOEHE
                                    .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                                    .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                                    .Placement = xlMoveAndSize
                              End With
                              
                              'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                              
                        Set BILD = Nothing
                        
                        ZAEHLER = ZAEHLER + HOEHE
                        
                  End If

            Next

      Next

      ActiveSheet.Range(GHS_SYMBOLE & ZEILE_ANFANG & ":" & GHS_SYMBOLE & ZEILE_ENDE).Rows.EntireRow.AutoFit

End Function

This is really the bit where your code fits in but I'm just not sure how exactly to implement it within the loops.

If InStr(TEXT, BEZEICHNUNG) Then
                                                                                 
                        'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
                        Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)
                              With BILD 'Das Bild wird eingefügt --- The picture is inserted
                                    .ShapeRange.LockAspectRatio = msoFalse
                                    .Height = HOEHE
                                    .Width = HOEHE
                                    .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                                    .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                                    .Placement = xlMoveAndSize
                              End With
                              
                              'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                              
                        Set BILD = Nothing
                        
                        ZAEHLER = ZAEHLER + HOEHE
                        
                  End If

 

[sparky2205]

One other thing with your code, argPicFullName, where is this being populated?

I've been looking this up and the one part I can't come to grips with is the filename:=
I see numerous examples of filename:= ThisWorkbook.Path & "some network location"
How do I get the filename:= to refer to a worksheet in the same workbook?

 

[Alex Blakenburg]

I am really only guessing here so make sure you have backed up your current file.

Try replacing this code:

                      'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
                      Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)
                            With BILD 'Das Bild wird eingefügt --- The picture is inserted
                                  .ShapeRange.LockAspectRatio = msoFalse
                                  .Height = HOEHE
                                  .Width = HOEHE
                                  .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                                  .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                                  .Placement = xlMoveAndSize
                            End With
                            
                            'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                            
                      Set BILD = Nothing

With this code:
(The B30 destination if quite arbitrary, I am hoping the existing shape code will position it where it needs to go)

    Dim shpPictureToCopy As Shape
    
    With Sheets("Pictograms")
        Set shpPictureToCopy = .Shapes(BEZEICHNUNG).Duplicate
        shpPictureToCopy.Cut
    End With

    ActiveSheet.Range("B30").PasteSpecial (xlPasteAll)
    
    With Selection
        .Name = BEZEICHNUNG
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = HOEHE
        .Width = HOEHE
        .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
        .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
        .Placement = xlMoveAndSize
    End With

 

[GWteB]

I've converted your code into a slightly more condensed format. It's not as efficient as it could be but without insight of your worksheet and the desired result that isn't possible. Furthermore, I implemented the invocation of my post #2 function procedure in the code, as you requested.

One other thing with your code, argPicFullName, where is this being populated?

This prototyped variable is populated on invocation of the GetPicToSheet function procedure.
Your variable ADRESSE is supposed to carry a valid path (and name) to a file on disk, containing an image (like c:\folder\image.jpg). De contents of this variable is then "injected" in the invoked GetPicToSheet procedure, along with the worksheet on wich that image from file should be placed.

Function GEFAHRSTOFFSYMBOL()                     ' hazardous substance symbol

    Const HOEHE       As Long = 29               'Wie hoch sollen die GHS-Symbole sein

    Dim ZEILE         As Long                    'ROW
    Dim ZEILE_ANFANG  As Long                    'LINE_START
    Dim ZEILE_ENDE    As Long                    'LINE_END
    Dim COLUMN        As Long
    Dim FIRST_COLUMN  As Long
    Dim LAST_COLUMN   As Long
    Dim FELD          As Long                    'FIELD
    Dim ZAEHLER       As Long                    'COUNTER

    Dim BRENNBAR              As Boolean         'FLAMMABLE
    Dim EXPLOSIV              As Boolean         'EXPLOSIVE
    Dim AETZEND               As Boolean         'CORRISIVE
    Dim GIFTIG                As Boolean         'POISONOUS
    Dim GESUNDHEITSSCHAEDLICH As Boolean         'HARMFUL

'    Dim BILD As Picture                          'IMAGE

    Dim BILD As Shape       ' <<<<< Shape Object type is needed !!!
    
    Dim GHS1 As String
    Dim GHS2 As String
    Dim GHS3 As String
    Dim GHS4 As String
    Dim GHS5 As String
    Dim GHS6 As String
    Dim GHS7 As String
    Dim GHS8 As String
    Dim GHS9 As String
    Dim TEXT As String

    Dim BEZEICHNUNG   As String                  'DESCRIPTION
    Dim ADRESSE       As String                  'ADDRESS
    'Dim H_SAETZE As Integer                     'H_PHRASE

    Dim GHS_NUMMERN   As String                  'GHS_NUMBERS
    Dim GHS_SYMBOLE   As String                  'GHS_SYMBOL

    'Hier kommt der Definitionsteil, in dem alle Parameter eingestellt werden
    'Here comes the definition part, in which all parameters are set
    '************************************************************************

    Dim oWs  As Worksheet
    Set oWs = ThisWorkbook.Worksheets("Pictograms")


    ZEILE_ANFANG = 5                             'Ab welcher Zele sollen die GHS-Symbole eingesetzt werden          --- From which row should the GHS symbols be used
    ZEILE_ENDE = oWs.Cells(oWs.Rows.Count, "A").End(xlUp).Row
    
    'ZEILE_ENDE = 100 'Bis zu welcher Zele sollen die GHS-Symbole eingesetzt werden                                 --- Up to which line should the GHS symbols be used
    FIRST_COLUMN = 10
    LAST_COLUMN = 17
    'H_SAETZE = 14 'In welcher Spalte stehen die H-Sätze                                                            --- In which column are the H_Phrases
    GHS_NUMMERN = "I"                            'In welche Spalte sollen die GHS-Nummern eingefügt werden          --- In which column should the GHS numbers be inserted
    GHS_SYMBOLE = "H"                            'In welche Spalte sollen die GHS-Symbole eingesetzt werden         --- In which column should the GHS symbols be placed

    ADRESSE = "K:\QUALITY\Hazard Symbols\"
    

    '************************************************************************
    'Hier endet der Definitionsteil, in dem alle Parameter eingestellt werden
    'This is where the definition section ends, in which all parameters are set


    'Folgende Ausschlussbedingungen gibt es:
    'There are the following exclusion conditions:
    '************************************************************************

    'a) Wenn GHS01 dann kein GHS02 und GHS03                      --- IF GHS01 THEN NO GHS02 AND GHS03
    'b) Wenn GHS06 dann kein GHS07                                --- IF GHS06 THEN NO GHS07
    'c) Wenn GHS05 und H315 oder H319 dann kein GHS07             --- IF GHS05 AND H315 OR H319 THEN NO GHS07
    'd) WENN GHS08 und H315 oder H317 oder H319 dann kein GHS07   --- IF GHS08 AND H315 OR H317 OR H319 THEN NO GHS07
    'e) Wenn GHS02 oder GHS06 dann kein GHS04                     --- IF GHS02 OR GHS06 THEN NO GHS04

    '************************************************************************
    'Hier endet die Beschreibung der Ausschlussbedingungen
    'The description of the exclusion conditions ends here

    Dim wks As Worksheet
    For Each wks In ActiveWorkbook.Worksheets    'Folgende Routine setzt alle Filterungen zurück, da sonst das Programm nicht richtig funktioniert --- The following routine removes all filters, otherwise the program will not work properly
        With wks
            If .FilterMode Then .ShowAllData
        End With
    Next wks

    oWs.Pictures.Delete                  'Bei jedem Programmaufruf werden alle Bilder erst einmal gelöscht, sonst würden immer mehr Bilder übereinander abgelegt --- Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
    oWs.Shapes.Delete
    oWs.Range("I5:I100").ClearContents

    Columns(GHS_SYMBOLE).ColumnWidth = HOEHE     'HEIGHT

    For ZEILE = ZEILE_ANFANG To ZEILE_ENDE       'FOR ROW = ROW_START TO ROW_END
        For COLUMN = FIRST_COLUMN To LAST_COLUMN - 1

            GHS1 = ""
            GHS2 = ""
            GHS3 = ""
            GHS4 = ""
            GHS5 = ""
            GHS6 = ""
            GHS7 = ""
            GHS8 = ""
            GHS9 = ""

            'TEXT = Range(H_SAETZE & ZEILE) ' RANGE(H_PHRASE & ROW)
            TEXT = Cells(ZEILE, COLUMN).Value
            'TEXT = Cells(4, 14).Value
            BRENNBAR = False                     ' FLAMMABLE
            EXPLOSIV = False                     ' EXPLOSIVE
            AETZEND = False                      ' CORROSIVE
            GIFTIG = False                       ' POISONOUS
            GESUNDHEITSSCHAEDLICH = False        ' HARMFUL

            Dim NumbersToBeComparedAgainst As Variant, i As Long

            NumbersToBeComparedAgainst = Array(200, 201, 202, 203, 204, 240, 241)

            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS1 = "Picture 1, "
                    EXPLOSIV = True
                    Exit For   ' << once one of these numbers is found a comparison against another number is redundant, so jump out of this loop
                End If
            Next i

            If EXPLOSIV = True Then

                NumbersToBeComparedAgainst = Array(220, 222, 223, 224, 225, 228, 241, 242, 250, 252, 260, 261)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS2 = "Picture 2, "
                        BRENNBAR = True                 ' FLAMMABLE
                        Exit For
                    End If
                Next i
                NumbersToBeComparedAgainst = Array(226, 251)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS2 = "Picture 2, "
                        Exit For
                    End If
                Next i
                NumbersToBeComparedAgainst = Array(270, 271, 272)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS3 = "Picture 3, "
                        Exit For
                    End If
                Next i
            End If

            NumbersToBeComparedAgainst = Array(300, 301, 310, 311, 330, 331)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS6 = "Picture 6, "
                    GIFTIG = True                       ' POISONOUS
                    Exit For
                End If
            Next i

            If BRENNBAR = True Then
                If GIFTIG = True Then
                    
                    If InStr(TEXT, "280") Then
                        GHS4 = "Picture 4, "
                    ElseIf InStr(TEXT, "281") Then
                        GHS4 = "Picture 4, "
                    End If
                End If
            End If
                              
            If InStr(TEXT, "334") Then
                GHS8 = "Picture 8, "
                GESUNDHEITSSCHAEDLICH = True     ' HARMFUL
            End If
            
            NumbersToBeComparedAgainst = Array(290, 314, 318)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS5 = "Picture 5, "
                    AETZEND = True               ' CORROSIVE
                    Exit For
                End If
            Next i
            NumbersToBeComparedAgainst = Array(304, 340, 341, 350, 351, 360, 361, 370, 371, 372, 373)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS8 = "Picture 8, "
                    Exit For
                End If
            Next i

            If GIFTIG = False Then
            
                NumbersToBeComparedAgainst = Array(302, 312, 332)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS7 = "Picture 7, "
                        Exit For
                    End If
                Next i
                  
                If AETZEND = False Then
                    If GESUNDHEITSSCHAEDLICH = False Then
                        If InStr(TEXT, "315") Then
                            GHS7 = "Picture 7, "
                        ElseIf InStr(TEXT, "319") Then
                            GHS7 = "Picture 7, "
                        End If
                    End If
                End If
                  
                If GESUNDHEITSSCHAEDLICH = False Then
                    If InStr(TEXT, "317") Then
                        GHS7 = "Picture 7, "
                    End If
                End If
                  
                NumbersToBeComparedAgainst = Array(335, 336, 420)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS7 = "Picture 7, "
                        Exit For
                    End If
                Next i
            End If
                            
            NumbersToBeComparedAgainst = Array(400, 410, 411)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS9 = "Picture 9, "
                    Exit For
                End If
            Next i

            Range(GHS_NUMMERN & ZEILE) = Range(GHS_NUMMERN & ZEILE) + GHS1 + GHS2 + GHS3 + GHS4 + GHS5 + GHS6 + GHS7 + GHS8 + GHS9 ' GHS_NUMBERS & ROW)
            'TEXT = Range(GHS_NUMMERN & ZEILE).Value

        Next COLUMN
    Next ZEILE


    For ZEILE = ZEILE_ANFANG To ZEILE_ENDE       'Jede Zeile wird überprüft --- Every line is checked
      
        TEXT = Range(GHS_NUMMERN & ZEILE)
        ZAEHLER = 0

        For FELD = 1 To 9                        'Jedes Gefahrensymbol wird gesucht --- Every danger symbol is searched for

            BEZEICHNUNG = "Picture " & CStr(FELD)        '"GHS0?" ' DESCRIPTION

            If InStr(TEXT, BEZEICHNUNG) Then
                                                                                 
''''                'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
''''                Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)

' ==================================================================================================================================

                ' >>>>  invocation of separate function <<<
                Set BILD = GetPicToSheet(ADRESSE & BEZEICHNUNG & ".png", oWs)
                
                ' >>>>  proceed on successful result, otherwise jump over <<<
                If Not BILD Is Nothing Then
                    
                    ' >>>> perform some required adjustments to the imported image <<<
                    With BILD
                        .LockAspectRatio = msoFalse
                        .Height = HOEHE
                        .Width = HOEHE
                        .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                        .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                        .Placement = xlMoveAndSize
                    End With
                End If
                
' ==================================================================================================================================
                              
                'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                              
                Set BILD = Nothing
                        
                ZAEHLER = ZAEHLER + HOEHE
            End If
        Next FELD
    Next ZEILE

    oWs.Range(GHS_SYMBOLE & ZEILE_ANFANG & ":" & GHS_SYMBOLE & ZEILE_ENDE).Rows.EntireRow.AutoFit

End Function

 

[sparky2205]

I've converted your code into a slightly more condensed format. It's not as efficient as it could be but without insight of your worksheet and the desired result that isn't possible. Furthermore, I implemented the invocation of my post #2 function procedure in the code, as you requested.


This prototyped variable is populated on invocation of the GetPicToSheet function procedure.
Your variable ADRESSE is supposed to carry a valid path (and name) to a file on disk, containing an image (like c:\folder\image.jpg). De contents of this variable is then "injected" in the invoked GetPicToSheet procedure, along with the worksheet on wich that image from file should be placed.

Function GEFAHRSTOFFSYMBOL()                     ' hazardous substance symbol

    Const HOEHE       As Long = 29               'Wie hoch sollen die GHS-Symbole sein

    Dim ZEILE         As Long                    'ROW
    Dim ZEILE_ANFANG  As Long                    'LINE_START
    Dim ZEILE_ENDE    As Long                    'LINE_END
    Dim COLUMN        As Long
    Dim FIRST_COLUMN  As Long
    Dim LAST_COLUMN   As Long
    Dim FELD          As Long                    'FIELD
    Dim ZAEHLER       As Long                    'COUNTER

    Dim BRENNBAR              As Boolean         'FLAMMABLE
    Dim EXPLOSIV              As Boolean         'EXPLOSIVE
    Dim AETZEND               As Boolean         'CORRISIVE
    Dim GIFTIG                As Boolean         'POISONOUS
    Dim GESUNDHEITSSCHAEDLICH As Boolean         'HARMFUL

'    Dim BILD As Picture                          'IMAGE

    Dim BILD As Shape       ' <<<<< Shape Object type is needed !!!
   
    Dim GHS1 As String
    Dim GHS2 As String
    Dim GHS3 As String
    Dim GHS4 As String
    Dim GHS5 As String
    Dim GHS6 As String
    Dim GHS7 As String
    Dim GHS8 As String
    Dim GHS9 As String
    Dim TEXT As String

    Dim BEZEICHNUNG   As String                  'DESCRIPTION
    Dim ADRESSE       As String                  'ADDRESS
    'Dim H_SAETZE As Integer                     'H_PHRASE

    Dim GHS_NUMMERN   As String                  'GHS_NUMBERS
    Dim GHS_SYMBOLE   As String                  'GHS_SYMBOL

    'Hier kommt der Definitionsteil, in dem alle Parameter eingestellt werden
    'Here comes the definition part, in which all parameters are set
    '************************************************************************

    Dim oWs  As Worksheet
    Set oWs = ThisWorkbook.Worksheets("Pictograms")


    ZEILE_ANFANG = 5                             'Ab welcher Zele sollen die GHS-Symbole eingesetzt werden          --- From which row should the GHS symbols be used
    ZEILE_ENDE = oWs.Cells(oWs.Rows.Count, "A").End(xlUp).Row
   
    'ZEILE_ENDE = 100 'Bis zu welcher Zele sollen die GHS-Symbole eingesetzt werden                                 --- Up to which line should the GHS symbols be used
    FIRST_COLUMN = 10
    LAST_COLUMN = 17
    'H_SAETZE = 14 'In welcher Spalte stehen die H-Sätze                                                            --- In which column are the H_Phrases
    GHS_NUMMERN = "I"                            'In welche Spalte sollen die GHS-Nummern eingefügt werden          --- In which column should the GHS numbers be inserted
    GHS_SYMBOLE = "H"                            'In welche Spalte sollen die GHS-Symbole eingesetzt werden         --- In which column should the GHS symbols be placed

    ADRESSE = "K:\QUALITY\Hazard Symbols\"
   

    '************************************************************************
    'Hier endet der Definitionsteil, in dem alle Parameter eingestellt werden
    'This is where the definition section ends, in which all parameters are set


    'Folgende Ausschlussbedingungen gibt es:
    'There are the following exclusion conditions:
    '************************************************************************

    'a) Wenn GHS01 dann kein GHS02 und GHS03                      --- IF GHS01 THEN NO GHS02 AND GHS03
    'b) Wenn GHS06 dann kein GHS07                                --- IF GHS06 THEN NO GHS07
    'c) Wenn GHS05 und H315 oder H319 dann kein GHS07             --- IF GHS05 AND H315 OR H319 THEN NO GHS07
    'd) WENN GHS08 und H315 oder H317 oder H319 dann kein GHS07   --- IF GHS08 AND H315 OR H317 OR H319 THEN NO GHS07
    'e) Wenn GHS02 oder GHS06 dann kein GHS04                     --- IF GHS02 OR GHS06 THEN NO GHS04

    '************************************************************************
    'Hier endet die Beschreibung der Ausschlussbedingungen
    'The description of the exclusion conditions ends here

    Dim wks As Worksheet
    For Each wks In ActiveWorkbook.Worksheets    'Folgende Routine setzt alle Filterungen zurück, da sonst das Programm nicht richtig funktioniert --- The following routine removes all filters, otherwise the program will not work properly
        With wks
            If .FilterMode Then .ShowAllData
        End With
    Next wks

    oWs.Pictures.Delete                  'Bei jedem Programmaufruf werden alle Bilder erst einmal gelöscht, sonst würden immer mehr Bilder übereinander abgelegt --- Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
    oWs.Shapes.Delete
    oWs.Range("I5:I100").ClearContents

    Columns(GHS_SYMBOLE).ColumnWidth = HOEHE     'HEIGHT

    For ZEILE = ZEILE_ANFANG To ZEILE_ENDE       'FOR ROW = ROW_START TO ROW_END
        For COLUMN = FIRST_COLUMN To LAST_COLUMN - 1

            GHS1 = ""
            GHS2 = ""
            GHS3 = ""
            GHS4 = ""
            GHS5 = ""
            GHS6 = ""
            GHS7 = ""
            GHS8 = ""
            GHS9 = ""

            'TEXT = Range(H_SAETZE & ZEILE) ' RANGE(H_PHRASE & ROW)
            TEXT = Cells(ZEILE, COLUMN).Value
            'TEXT = Cells(4, 14).Value
            BRENNBAR = False                     ' FLAMMABLE
            EXPLOSIV = False                     ' EXPLOSIVE
            AETZEND = False                      ' CORROSIVE
            GIFTIG = False                       ' POISONOUS
            GESUNDHEITSSCHAEDLICH = False        ' HARMFUL

            Dim NumbersToBeComparedAgainst As Variant, i As Long

            NumbersToBeComparedAgainst = Array(200, 201, 202, 203, 204, 240, 241)

            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS1 = "Picture 1, "
                    EXPLOSIV = True
                    Exit For   ' << once one of these numbers is found a comparison against another number is redundant, so jump out of this loop
                End If
            Next i

            If EXPLOSIV = True Then

                NumbersToBeComparedAgainst = Array(220, 222, 223, 224, 225, 228, 241, 242, 250, 252, 260, 261)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS2 = "Picture 2, "
                        BRENNBAR = True                 ' FLAMMABLE
                        Exit For
                    End If
                Next i
                NumbersToBeComparedAgainst = Array(226, 251)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS2 = "Picture 2, "
                        Exit For
                    End If
                Next i
                NumbersToBeComparedAgainst = Array(270, 271, 272)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS3 = "Picture 3, "
                        Exit For
                    End If
                Next i
            End If

            NumbersToBeComparedAgainst = Array(300, 301, 310, 311, 330, 331)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS6 = "Picture 6, "
                    GIFTIG = True                       ' POISONOUS
                    Exit For
                End If
            Next i

            If BRENNBAR = True Then
                If GIFTIG = True Then
                   
                    If InStr(TEXT, "280") Then
                        GHS4 = "Picture 4, "
                    ElseIf InStr(TEXT, "281") Then
                        GHS4 = "Picture 4, "
                    End If
                End If
            End If
                             
            If InStr(TEXT, "334") Then
                GHS8 = "Picture 8, "
                GESUNDHEITSSCHAEDLICH = True     ' HARMFUL
            End If
           
            NumbersToBeComparedAgainst = Array(290, 314, 318)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS5 = "Picture 5, "
                    AETZEND = True               ' CORROSIVE
                    Exit For
                End If
            Next i
            NumbersToBeComparedAgainst = Array(304, 340, 341, 350, 351, 360, 361, 370, 371, 372, 373)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS8 = "Picture 8, "
                    Exit For
                End If
            Next i

            If GIFTIG = False Then
           
                NumbersToBeComparedAgainst = Array(302, 312, 332)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS7 = "Picture 7, "
                        Exit For
                    End If
                Next i
                 
                If AETZEND = False Then
                    If GESUNDHEITSSCHAEDLICH = False Then
                        If InStr(TEXT, "315") Then
                            GHS7 = "Picture 7, "
                        ElseIf InStr(TEXT, "319") Then
                            GHS7 = "Picture 7, "
                        End If
                    End If
                End If
                 
                If GESUNDHEITSSCHAEDLICH = False Then
                    If InStr(TEXT, "317") Then
                        GHS7 = "Picture 7, "
                    End If
                End If
                 
                NumbersToBeComparedAgainst = Array(335, 336, 420)
                For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                    If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                        GHS7 = "Picture 7, "
                        Exit For
                    End If
                Next i
            End If
                           
            NumbersToBeComparedAgainst = Array(400, 410, 411)
            For i = LBound(NumbersToBeComparedAgainst) To UBound(NumbersToBeComparedAgainst)
                If VBA.InStr(TEXT, CStr(NumbersToBeComparedAgainst(i))) Then
                    GHS9 = "Picture 9, "
                    Exit For
                End If
            Next i

            Range(GHS_NUMMERN & ZEILE) = Range(GHS_NUMMERN & ZEILE) + GHS1 + GHS2 + GHS3 + GHS4 + GHS5 + GHS6 + GHS7 + GHS8 + GHS9 ' GHS_NUMBERS & ROW)
            'TEXT = Range(GHS_NUMMERN & ZEILE).Value

        Next COLUMN
    Next ZEILE


    For ZEILE = ZEILE_ANFANG To ZEILE_ENDE       'Jede Zeile wird überprüft --- Every line is checked
     
        TEXT = Range(GHS_NUMMERN & ZEILE)
        ZAEHLER = 0

        For FELD = 1 To 9                        'Jedes Gefahrensymbol wird gesucht --- Every danger symbol is searched for

            BEZEICHNUNG = "Picture " & CStr(FELD)        '"GHS0?" ' DESCRIPTION

            If InStr(TEXT, BEZEICHNUNG) Then
                                                                                
''''                'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
''''                Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)

' ==================================================================================================================================

                ' >>>>  invocation of separate function <<<
                Set BILD = GetPicToSheet(ADRESSE & BEZEICHNUNG & ".png", oWs)
               
                ' >>>>  proceed on successful result, otherwise jump over <<<
                If Not BILD Is Nothing Then
                   
                    ' >>>> perform some required adjustments to the imported image <<<
                    With BILD
                        .LockAspectRatio = msoFalse
                        .Height = HOEHE
                        .Width = HOEHE
                        .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                        .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                        .Placement = xlMoveAndSize
                    End With
                End If
               
' ==================================================================================================================================
                             
                'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                             
                Set BILD = Nothing
                       
                ZAEHLER = ZAEHLER + HOEHE
            End If
        Next FELD
    Next ZEILE

    oWs.Range(GHS_SYMBOLE & ZEILE_ANFANG & ":" & GHS_SYMBOLE & ZEILE_ENDE).Rows.EntireRow.AutoFit

End Function

Thanks for the reply and the code cleanup.
I think there might be a misunderstanding on what I'm trying to achieve.
Let me try and be clearer.

Current Scenario:
I have a spreadsheet with a worksheet called "Tabelle2".
Tabelle2 has a button which runs a macro to insert GHS Symbols from a network location.

Desired Scenario:
I have the same spreadsheet which now has a new worksheet called "Pictograms".
Instead of taking the GHS symbols from the network location I now want the spreadsheet to insert a copy of the relevant pictogram from the new worksheet "Pictograms" into the appropriate location on the "Tabelle2" worksheet.
I want to do this so I can send the spreadsheet to other sites as a complete package without having to ensure they setup the pictograms on the network correctly.

You have declared oWS as Worksheet = "Pictograms". "Pictograms" is the worksheet where I store my pictograms and where I want the code to look for the relevant pictogram each time.
So your code...
oWs.Pictures.Delete 'Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
oWs.Shapes.Delete
oWs.Range("I5:I100").ClearContents
... would actually delete my pictogram templates, which is not what I want.
The original code...
ActiveSheet.Pictures.Delete 'Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
ActiveSheet.Range("I5:I100").ClearContents
... clears any pictograms inserted into the "Tabelle2" worksheet before rerunning the insert to prevent a buildup of old and new pictograms.

I have other similar problems with oWS being declared as Worksheet("Pictograms") in other areas of the code.

I know it is difficult to accomplish what I want without having the spreadsheet to work with and I really appreciate your help with this.
If you do have time to have another look at this with that explanation it would really be a great help to me as I am struggling to get there myself.
Also if you need any clarification please let me know and I will respond asap.

 

[sparky2205]

I am really only guessing here so make sure you have backed up your current file.

Try replacing this code:

                      'Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG + ".png") 'Hier wird die Adresse des Bildes generiert
                      Set BILD = ActiveSheet.Pictures.Insert(ADRESSE + BEZEICHNUNG)
                            With BILD 'Das Bild wird eingefügt --- The picture is inserted
                                  .ShapeRange.LockAspectRatio = msoFalse
                                  .Height = HOEHE
                                  .Width = HOEHE
                                  .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                                  .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                                  .Placement = xlMoveAndSize
                            End With
                           
                            'Range(GHS_SYMBOLE & ZEILE).FormulaLocal = "=CHAR(10)"
                           
                      Set BILD = Nothing

With this code:
(The B30 destination if quite arbitrary, I am hoping the existing shape code will position it where it needs to go)

    Dim shpPictureToCopy As Shape
   
    With Sheets("Pictograms")
        Set shpPictureToCopy = .Shapes(BEZEICHNUNG).Duplicate
        shpPictureToCopy.Cut
    End With

    ActiveSheet.Range("B30").PasteSpecial (xlPasteAll)
   
    With Selection
        .Name = BEZEICHNUNG
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = HOEHE
        .Width = HOEHE
        .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
        .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
        .Placement = xlMoveAndSize
    End With

Hi Alex,
I got your code to work with some slight modifications.
The modifications were necessary because I had to protect and hide the Pictograms worksheet. I had to change activesheet in a few places.
It works well now except for one thing, the autofit.
I added a new row to the Tabelle2 worksheet and ran the macro. It brought in the correct GHS symbol which is the main aim of the project.
But as it doesn't autofit the new row the picture overruns the row. If I manually drag the row down it stretches the picture.
There are merged columns in the worksheet but no merged rows.
Any idea what might be causing this?
I'm adding my latest code in it's entirety below in case you need to see it in context.
The autofit is a couple of lines from the end.

Function GEFAHRSTOFFSYMBOL() ' hazardous substance symbol

      Dim ZEILE As Variant 'ROW
      Dim ZEILE_ANFANG As Variant 'LINE_START
      Dim ZEILE_ENDE As Variant 'LINE_END
      Dim COLUMN As Variant
      Dim FIRST_COLUMN As Variant
      Dim LAST_COLUMN As Variant
      Dim FELD As Variant 'FIELD
      Dim ZAEHLER As Variant 'COUNTER
      Dim HOEHE As Variant 'HEIGHT
      Dim BRENNBAR As Variant 'FLAMMABLE
      Dim EXPLOSIV As Variant 'EXPLOSIVE
      Dim AETZEND As Variant 'CORRISIVE
      Dim GIFTIG As Variant 'POISONOUS
      Dim GESUNDHEITSSCHAEDLICH As Variant 'HARMFUL
                  
      Dim BILD As Picture 'IMAGE
      
      Dim pw As String
      Dim GHS1 As String
      Dim GHS2 As String
      Dim GHS3 As String
      Dim GHS4 As String
      Dim GHS5 As String
      Dim GHS6 As String
      Dim GHS7 As String
      Dim GHS8 As String
      Dim GHS9 As String
      Dim TEXT As String
      Dim BEZEICHNUNG As String 'DESCRIPTION
      Dim GHS_NUMMERN As String 'GHS_NUMBERS
      Dim GHS_SYMBOLE As String 'GHS_SYMBOL
      
      Application.ScreenUpdating = False
      pw = "Test"
      On Error GoTo errhandler
      
'      With Worksheets("Pictograms")
'                .Visible = True
'                .Unprotect Password:=pw
'      End With
      
      'Hier kommt der Definitionsteil, in dem alle Parameter eingestellt werden
      'Here comes the definition part, in which all parameters are set
      '************************************************************************
            
      ZEILE_ANFANG = 5 'Ab welcher Zele sollen die GHS-Symbole eingesetzt werden --- From which row should the GHS symbols be used
      ZEILE_ENDE = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 'Bis zu welcher Zele sollen die GHS-Symbole eingesetzt werden --- Up to which line should the GHS symbols be used (Get the last used row)
      FIRST_COLUMN = 10
      LAST_COLUMN = 17
      GHS_NUMMERN = "I" 'In welche Spalte sollen die GHS-Nummern eingefügt werden --- In which column should the GHS numbers be inserted
      HOEHE = 29 'Wie hoch sollen die GHS-Symbole sein --- How high should the GHS symbols be
      GHS_SYMBOLE = "H" 'In welche Spalte sollen die GHS-Symbole eingesetzt werden --- In which column should the GHS symbols be placed
      '************************************************************************
      'Hier endet der Definitionsteil, in dem alle Parameter eingestellt werden
      'This is where the definition section ends, in which all parameters are set
      
      
      'Folgende Ausschlussbedingungen gibt es:
      'There are the following exclusion conditions:
      '************************************************************************
      
      'a) Wenn GHS01 dann kein GHS02 und GHS03 --- IF GHS01 THEN NO GHS02 AND GHS03
      'b) Wenn GHS06 dann kein GHS07 --- IF GHS06 THEN NO GHS07
      'c) Wenn GHS05 und H315 oder H319 dann kein GHS07 --- IF GHS05 AND H315 OR H319 THEN NO GHS07
      'd) WENN GHS08 und H315 oder H317 oder H319 dann kein GHS07 --- IF GHS08 AND H315 OR H317 OR H319 THEN NO GHS07
      'e) Wenn GHS02 oder GHS06 dann kein GHS04 --- IF GHS02 OR GHS06 THEN NO GHS04
      
      '************************************************************************
      'Hier endet die Beschreibung der Ausschlussbedingungen
      'The description of the exclusion conditions ends here
      
      
      For Each wks In ActiveWorkbook.Worksheets 'Folgende Routine setzt alle Filterungen zurück, da sonst das Programm nicht richtig funktioniert --- The following routine removes all filters, otherwise the program will not work properly
            With wks
                  If .FilterMode Then .ShowAllData
            End With
      Next wks
      
      Worksheets("Tabelle2").Pictures.Delete 'Bei jedem Programmaufruf werden alle Bilder erst einmal gelöscht, sonst würden immer mehr Bilder übereinander abgelegt --- Each time the program is called, all images are first deleted, otherwise more and more images would be stored on top of each other
      Worksheets("tabelle2").Range("I5:I" & ZEILE_ENDE).ClearContents
      
      Columns(GHS_SYMBOLE).ColumnWidth = HOEHE 'HEIGHT
      
      For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'FOR ROW = ROW_START TO ROW_END
      
        For COLUMN = FIRST_COLUMN To LAST_COLUMN - 1
                  
            GHS1 = ""
            GHS2 = ""
            GHS3 = ""
            GHS4 = ""
            GHS5 = ""
            GHS6 = ""
            GHS7 = ""
            GHS8 = ""
            GHS9 = ""
      
            TEXT = Cells(ZEILE, COLUMN).Value
            BRENNBAR = 0 ' FLAMMABLE
            EXPLOSIV = 0 ' EXPLOSIVE
            AETZEND = 0 ' CORROSIVE
            GIFTIG = 0 ' POISONOUS
            GESUNDHEITSSCHAEDLICH = 0 ' HARMFUL
            
            If InStr(TEXT, "200") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "201") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "202") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "203") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "204") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "240") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
                  
            If InStr(TEXT, "241") Then
            
                  GHS1 = "Picture 1, "
                  EXPLOSIV = 1
                  
            End If
            
            If EXPLOSIV = 0 Then
            
                  If InStr(TEXT, "220") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1 ' FLAMMABLE
                  
                  End If
                  
                  If InStr(TEXT, "222") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "223") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "224") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "225") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "226") Then
            
                        GHS2 = "Picture 2, "
                  
                  End If
                  
                  If InStr(TEXT, "228") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "241") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "242") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "250") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "251") Then
            
                        GHS2 = "Picture 2, "
                  
                  End If
                  
                  If InStr(TEXT, "252") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "260") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "261") Then
            
                        GHS2 = "Picture 2, "
                        BRENNBAR = 1
                  
                  End If
                  
                  If InStr(TEXT, "270") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
                  
                  If InStr(TEXT, "271") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
                  
                  If InStr(TEXT, "272") Then
            
                        GHS3 = "Picture 3, "
                  
                  End If
            
            End If
            
            If InStr(TEXT, "300") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1 ' POISONOUS
                  
            End If
                  
            If InStr(TEXT, "301") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "310") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "311") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "330") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
                  
            If InStr(TEXT, "331") Then
            
                  GHS6 = "Picture 6, "
                  GIFTIG = 1
                  
            End If
            
            If BRENNBAR = 0 Then
            
                  If GIFTIG = 0 Then
            
                        If InStr(TEXT, "280") Then
            
                              GHS4 = "Picture 4, "
                  
                        End If
                  
                        If InStr(TEXT, "281") Then
            
                              GHS4 = "Picture 4, "
                  
                        End If
            
                  End If
            
            End If
                              
            If InStr(TEXT, "290") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1 ' CORROSIVE
                  
            End If
                  
            If InStr(TEXT, "314") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1
                  
            End If
                  
            If InStr(TEXT, "318") Then
            
                  GHS5 = "Picture 5, "
                  AETZEND = 1
                  
            End If
                  
            If InStr(TEXT, "334") Then
            
                  GHS8 = "Picture 8, "
                  GESUNDHEITSSCHAEDLICH = 1 ' HARMFUL
                  
            End If
                  
            If InStr(TEXT, "340") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "341") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "350") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "351") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "360") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "361") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "370") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "371") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "372") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "373") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
                  
            If InStr(TEXT, "304") Then
            
                  GHS8 = "Picture 8, "
                  
            End If
            
            If GIFTIG = 0 Then
            
                  If InStr(TEXT, "302") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "312") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "332") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If AETZEND = 0 Then
                  
                        If GESUNDHEITSSCHAEDLICH = 0 Then
                  
                              If InStr(TEXT, "315") Then
            
                                  GHS7 = "Picture 7, "
                  
                              End If
                  
                              If InStr(TEXT, "319") Then
            
                                  GHS7 = "Picture 7, "
                  
                              End If
                  
                        End If
                  
                  End If
                  
                  If GESUNDHEITSSCHAEDLICH = 0 Then
                  
                        If InStr(TEXT, "317") Then
            
                            GHS7 = "Picture 7, "
                  
                        End If
                  
                  End If
                  
                  If InStr(TEXT, "335") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "336") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
                  
                  If InStr(TEXT, "420") Then
            
                      GHS7 = "Picture 7, "
                  
                  End If
            
            End If
                            
            If InStr(TEXT, "400") Then
            
                  GHS9 = "Picture 9, "
                  
            End If
                  
            If InStr(TEXT, "410") Then
            
                  GHS9 = "Picture 9, "
                  
            End If
                  
            If InStr(TEXT, "411") Then
            
                  GHS9 = "Picture 9, "
            
            End If
            
            Range(GHS_NUMMERN & ZEILE) = Range(GHS_NUMMERN & ZEILE) + GHS1 + GHS2 + GHS3 + GHS4 + GHS5 + GHS6 + GHS7 + GHS8 + GHS9 ' GHS_NUMBERS & ROW)
                 
        Next
      
      Next
            
      For ZEILE = ZEILE_ANFANG To ZEILE_ENDE 'Jede Zeile wird überprüft --- Every line is checked
            
            TEXT = Range(GHS_NUMMERN & ZEILE)
            ZAEHLER = 0

            For FELD = 1 To 9 'Jedes Gefahrensymbol wird gesucht --- Every danger symbol is searched for
                  
                  Select Case FELD ' FIELD
                  
                        Case Is = 1
                              BEZEICHNUNG = "Picture 1" '"GHS01" ' DESCRIPTION
                  
                        Case Is = 2
                              BEZEICHNUNG = "Picture 2" '"GHS02"
                  
                        Case Is = 3
                              BEZEICHNUNG = "Picture 3" '"GHS03"
                  
                        Case Is = 4
                              BEZEICHNUNG = "Picture 4" '"GHS04"
                  
                        Case Is = 5
                              BEZEICHNUNG = "Picture 5" '"GHS05"
                  
                        Case Is = 6
                              BEZEICHNUNG = "Picture 6" '"GHS06"
                  
                        Case Is = 7
                              BEZEICHNUNG = "Picture 7" '"GHS07"
                  
                        Case Is = 8
                              BEZEICHNUNG = "Picture 8" '"GHS08"
                  
                        Case Is = 9
                              BEZEICHNUNG = "Picture 9" '"GHS09"
                  
                    End Select
                  If InStr(TEXT, BEZEICHNUNG) Then
                        
                        Dim shpPictureToCopy As Shape
    
                        With Worksheets("Pictograms")
                            .Visible = True
                            .Unprotect Password:=pw
                        End With
    
                        With Sheets("Pictograms")
                            Set shpPictureToCopy = .Shapes(BEZEICHNUNG).Duplicate
                            shpPictureToCopy.Cut
                        End With
                    
                        Worksheets("Tabelle2").Range("B30").PasteSpecial (xlPasteAll)
                        
                        With Selection
                            .Name = BEZEICHNUNG
                            .ShapeRange.LockAspectRatio = msoFalse
                            .Height = HOEHE
                            .Width = HOEHE
                            .Top = Range(GHS_SYMBOLE & ZEILE).Top + 1
                            .Left = Range(GHS_SYMBOLE & ZEILE).Left + ZAEHLER + 1 ' COUNTER
                            .Placement = xlMoveAndSize
                        End With
                        
                        ZAEHLER = ZAEHLER + HOEHE
                        
                  End If

            Next

      Next

      Worksheets("Tabelle2").Range(GHS_SYMBOLE & ZEILE_ANFANG & ":" & GHS_SYMBOLE & ZEILE_ENDE).Rows.EntireRow.AutoFit
            
      With Worksheets("Pictograms")
                .Protect Password:=pw
                .Visible = False
      End With
      
      Application.ScreenUpdating = True
      
      Worksheets("Tabelle2").Range("A5").Select
      
errhandler:
      Application.ScreenUpdating = True
      
End Function

 

[GWteB]

Right, I must have misread your query. Your current explanation is very clear.
Just to be sure, hopefully you did NOT obtain the network located GHS Symbols onto your "Pictograms" worksheet with the Sheet.Pictures.Insert method, otherwise your "complete package" concept will not work. The mentioned VBA method doesn't embed the pictures in your workbook, it creates just links to the files on the network share. Reading your post#1 I was triggered by that the first time and that's where my GetPictToSheet comes into the picture. Meanwhile I overlooked what you're mainly aiming for.

If I understand correctly, you have almost reached your goal with the code from @Alex Blakenburg. Then I'll let it rest for now.

 

[Alex Blakenburg]

@GWteB
I am in Australia and just had a quick peak.
It is 4 am here. If you do have any ideas on the question @sparky2205 is asking regarding positioning, your assistance would be appreciated.