How to make hexagonal cells in Excel and random generation in them?

Question

excel

How to make similar cells in Excel?

You also need to make sure that when you press the button, 15-20 cells are randomly generated in which there will be an object (in this case, a cactus)

Answer 1

Sub Hexagone(Row As Integer, Col As Integer, Size As Integer)
    Range(Cells(Row, Col), Cells(Row + 2, Col + 1)).Select
    With Selection
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
    Cells(Row, Col).Select
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row, Col + 1).Select
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 1, Col + 1).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 2, Col + 1).Select
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 2, Col).Select
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 1, Col).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    If ((Row + 3) < (4 * Size - 1)) Then
        Cells(Row + 3, Col).Select
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    End If
End Sub

Sub Grid()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim Size As Integer
    Dim Xn As Integer, Yn As Integer
    
    Set WB = Excel.ActiveWorkbook
    Set WS = WB.Worksheets("Ëèñò1")
    WS.Activate
    
    Size = 15
    
    Range(Cells(1, 1), Cells(4 * Size - 1, 2 * Size)).Select
    Selection.Clear
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Yn = 1
    For y = 1 To Size
        Xn = 1
        For x = 1 To Size
            Call Hexagone(Yn, Xn, Size)
            Xn = Xn + 2
        Next x
        Yn = Yn + 4
    Next y
    
    Randomize
    For Picture = 1 To 20
        x = Int(Size * Rnd) + 1
        y = Int(Size * Rnd) + 1
        If (y Mod 2 = 0) Then
            x = x + 1
        End If
        Cells(3 * y - 1, 2 * x - 1).Select
        ActiveSheet.Pictures.Insert( _
        "C:\Program Files (x86)\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18253_.wmf") _
        .Select
        Selection.ShapeRange.ScaleWidth 0.3016920425, msoFalse, msoScaleFromTopLeft
    Next Picture
End Sub

More or less like this. Grid 15 * 15 and 20 drawings.