VBA change position of a created barcode object

[Weeble]

So I found this code that creates barcodes as an object, problem is the barcode that is created always ends up to the right side of the formula.
I've tried to change the X and Y variables, but can't really find a way so that it always posts it below the cell not to the right side of the cell.


Also it seams to have a bug in the code. If I sometimes update a table in any workbook, it can automaticly create barcodes across different sheets and workbooks. Any help to what is all about would also be helpful.

Option Explicit




Public Function BarCode_Function(Input_Cell As Range)
    '------------------< BarCode_Function() >------------------
    '< get Input >
    Dim wert As String
    wert = Input_Cell.Formula
    Dim CellID As String
    CellID = "BarCode_" & Input_Cell.Column & "_" & Input_Cell.Row
    
    Dim x As Integer, Y As Integer, Heigth As Integer
    x = Input_Cell.Left + Input_Cell.Width + 2
    
    Y = Input_Cell.Top + 2
    Heigth = Input_Cell.Height - 4
    '<!-- get Input -->
    
    '< create Barcode 39 >
    paintCode39 wert, ActiveSheet, "Barcode_" & CellID, 1, x, Y, Heigth
    '<!-- create Barcode 39 -->
    
    On Error Resume Next
    delete_Shape_Clones
    
    
    '< Ausgabe >
    BarCode_Function = ""
    '<!-- Ausgabe -->
    '------------------<!-- BarCode_Function() -->------------------
End Function








' -------------------------------------------------------------------
Public Sub paintCode39(ByVal Value As String, _
                       ByRef Sheet As Worksheet, _
                       ByVal Name As String, _
                       ByVal ScaleFactor As Integer, _
                       ByVal x As Integer, _
                       ByVal Y As Integer, _
                       ByVal Height As Integer _
                       )
    ' Skapa variabel
    Dim i As Integer
    Dim j As Integer
    Dim sh As Shape
    Dim code As String
    Dim varArray() As Variant
    Dim iCount As Integer
    
    'Initiera positionsvariabeln
    
    'vid behov lägg till start och stoppa tecken till det värde som ska visas
    If Left(Value, 1) <> "*" Then Value = "*" & Value
    If Right(Value, 1) <> "*" Then Value = Value & "*"
    
    ' Bestäm om det redan finns en gammal version av streckkoden
    ' ligger på arbetsbladet.
    For Each sh In Sheet.Shapes
        If sh.Name = Name Then
            sh.Delete
        End If
    Next
    
    'Gå igenom värdet som ska visas karaktär för tecken
    For i = 1 To Len(Value)
    
        ' Koda nuvarande tecken enligt kartläggningstabellen
        'Exempel: A blir 1101010010110
        code = getCode(Mid(Value, i, 1))
        
        ' Kontrollera om giltig kodning hittades.
        If code = "" Then
            ' MsgBox "Streckkodstillverkning avbru****.", _
             '      vbCritical, _
              '      "Odefinierad karaktär"
            Exit For
        End If
        
        ' gå genom baren genom baren
        For j = 1 To Len(code)
            ' Skapa nytt Shape-objekt med ScalFactor-bredd
            Set sh = Sheet.Shapes.AddShape(msoShapeRectangle, _
                                           x, _
                                           Y, _
                                           ScaleFactor, _
                                           Height)
            
            ' X-Position för att öka bredden på ScalFactor
            x = x + ScaleFactor
            
            ' Färg svart eller vitt beroende på aktuell kodform
            If Mid(code, j, 1) = 1 Then
                ' Kode = 1 --> svart
                sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
                sh.Line.ForeColor.RGB = RGB(0, 0, 0)
            Else
                ' Kode = 0 --> Vit
                sh.Fill.ForeColor.RGB = RGB(255, 255, 255)
                sh.Line.ForeColor.RGB = RGB(255, 255, 255)
            End If
            
            'Lägg till staplar i array för senare gruppering
            iCount = iCount + 1
            ReDim Preserve varArray(1 To iCount)
            varArray(iCount) = sh.Name
        Next
    Next
group:
    'Gruppera alla tidigare skapade staplar till en enda grafik
    Set sh = Sheet.Shapes.Range(varArray).group
    
    ' Namn grupperad grafik
    sh.Name = Name
End Sub




Private Function getCode(ByVal Character As String) As String
    Dim code As String
    Select Case UCase(Character)
        Case "*"
            code = "1001011011010"
        Case "0"
            code = "1010011011010"
        Case "1"
            code = "1101001010110"
        Case "2"
            code = "1011001010110"
        Case "3"
            code = "1101100101010"
        Case "4"
            code = "1010011010110"
        Case "5"
            code = "1101001101010"
        Case "6"
            code = "1011001101010"
        Case "7"
            code = "1010010110110"
        Case "8"
            code = "1101001011010"
        Case "9"
            code = "1011001011010"
        Case "A"
            code = "1101010010110"
        Case "B"
            code = "1011010010110"
        Case "C"
            code = "1101101001010"
        Case "D"
            code = "1010110010110"
        Case "E"
            code = "1101011001010"
        Case "F"
            code = "1011011001010"
        Case "G"
            code = "1010100110110"
        Case "H"
            code = "1101010011010"
        Case "I"
            code = "1011010011010"
        Case "J"
            code = "1010110011010"
        Case "K"
            code = "1101010100110"
        Case "L"
            code = "1011010100110"
        Case "M"
            code = "1101101010010"
        Case "N"
            code = "1010110100110"
        Case "O"
            code = "1101011010010"
        Case "P"
            code = "1011011010010"
        Case "Q"
            code = "1010101100110"
        Case "R"
            code = "1101010110010"
        Case "S"
            code = "1011010110010"
        Case "T"
            code = "1010110110010"
        Case "U"
            code = "1100101010110"
        Case "V"
            code = "1001101010110"
        Case "W"
            code = "1100110101010"
        Case "X"
            code = "1001011010110"
        Case "Y"
            code = "1100101101010"
        Case "Z"
            code = "1001101101010"
        Case "-"
            code = "1001010110110"
        Case "."
            code = "1100101011010"
        Case " "
            code = "1001101011010"
        Case "$"
            code = "1001001001010"
        Case "/"
            code = "1001001010010"
        Case "+"
            code = "1001010010010"
        Case "%"
            code = "1010010010010"
        Case Else
            code = ""
    End Select
    
    getCode = code
End Function




Private Sub delete_Shape_Clones()
    '-------------------< delete_Shape_Clones() >---------------
    Dim Sheet As Worksheet
    Set Sheet = ActiveSheet
    
    Dim iShape As Integer
    Dim nShapes As Integer
    nShapes = Sheet.Shapes.Count
    
    For iShape = 1 To nShapes
        
        Dim objShape As Shape
        Dim iLoop As Integer
        
        For iLoop = iShape + 1 To nShapes
            If Sheet.Shapes(iLoop).Name = Sheet.Shapes(iShape).Name Then
                Sheet.Shapes(iLoop).Delete
                nShapes = nShapes - 1
            End If
        Next
    Next
    '-------------------<!-- delete_Shape_Clones() -->---------------
End Sub

 

[Kamolga]

If input cell is B2 and you want barcode in B3,

I think you should use

[LEFT][COLOR=#333333][FONT=monospace]    x = Input_Cell.Left + 2
    
    Y = Input_Cell.Top + [COLOR=#333333][FONT=monospace]Input_Cell.Height [/FONT][/COLOR]+ 2
 [/FONT][/COLOR][/LEFT]

 

[Weeble]

Did not work , Posting it in D5, the barcode ended up in A8 :/