combobox resize

Question

i have added several combo boxes on a image which are linked to cells (from various spreadsheets) and the value is dynamic.

combobox are grouped with image

for example 

group A consist 1 image and 10 combo boxes

group B consist 1 image and 10 combo boxes

both groups are placed at same location

VB code hides one of them based on value

either group A or B is visible at a time

as soon as the value changes in the linked cells the size and location of combo boxes  changes.

they move from the location to a random location when code runs and size is also changed.

please recommend me the charges which i need to do in code/excel to avoid this.

Answer 1

After you have the combo boxes correctly positioned, you can run code to save the position and size of the combos on a worksheet.

You can then run code to resize and position the combos based on the saved data.

In the following code examples, the first sub creates a worksheet to save the position and sizes of the combos. You only run this code once after the combos are correctly positioned.

The second sub can be run anytime to reposition and size the combos.

Don't know how competent you are with VBA code but as a suggestion, you can place the reposition code in the worksheets module under the Worksheet Activation event so every time the worksheet is activated, the combos re-position and re-size. However, don't place it in there until after you have run the code to save the location and sizes otherwise it will error because the worksheet with the saved data will not be present. There are other options for where the code can be placed so it runs automatically but without your workbook and knowledge of your project I am not really in a position to determine the best setup. 

The code is not tested in office XP so I cannot guarantee it will work. Make a backup of your workbook before installing the code.

Feel free to get back to me with any questions.

Sub SaveCboData()

    'Run this sub first to save the position and sizes of the combos.

    Dim ws As Worksheet

    Dim wsCboData As Worksheet

    Dim shp As Shape

    Dim Shp2 As Shape

    Dim shpCbo As Shape

    Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your sheet name with combos

    On Error Resume Next

    Set wsCboData = Worksheets("CboData")   'To test if worksheet already exists

    On Error GoTo 0

    If wsCboData Is Nothing Then    'Worksheet does not exist so create and name

        Set wsCboData = Sheets.Add(After:=Sheets(Sheets.Count))

        wsCboData.Name = "CboData"

    End If

    With wsCboData  'Insert column headers

        .Cells.Clear

        '.Cells(1, "A") = "ComboGroup"

        .Cells(1, "A") = "ShapeName"

        .Cells(1, "B") = "Top"

        .Cells(1, "C") = "Left"

        .Cells(1, "D") = "Height"

        .Cells(1, "E") = "Width"

        .Range(.Cells(1, "A"), .Cells(1, "E")).Font.Bold = True

        '.Visible = xlSheetVeryHidden   'Can uncomment after testing

    End With

    For Each shp In ws.Shapes

        If shp.Type = msoGroup Then

            With wsCboData

                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = shp.Name   'Offsets to right

                .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = shp.Top   'Offsets to right

                .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = shp.Left   'Offsets to right

                .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 3) = shp.Height   'Offsets to right

                .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 4) = shp.Width   'Offsets to right

            End With

            For Each shpCbo In shp.GroupItems

                With wsCboData

                    '.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = shp.Name  'Offsets to next blank row

                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = shpCbo.Name  'Offsets to right

                    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 1) = shpCbo.Top   'Offsets to right

                    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 2) = shpCbo.Left   'Offsets to right

                    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 3) = shpCbo.Height   'Offsets to right

                    .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 4) = shpCbo.Width   'Offsets to right

                End With

            Next shpCbo

        End If

    Next shp

    wsCboData.Columns.AutoFit

End Sub

Sub ReSizeAndPosition()

    'Run this code anytime to reposition and size the combos as per the saved data.

    Dim ws As Worksheet

    Dim wsCboData As Worksheet

    Dim rngShapes As Range

    Dim cel As Range

    Dim shp As Shape

    Set ws = Worksheets("Sheet1")   'Edit "Sheet1" to your sheet name with combos

    Set wsCboData = Worksheets("CboData")

    With wsCboData

        Set rngShapes = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))

    End With

    For Each cel In rngShapes

        With ws

            Set shp = .Shapes(cel.Value)

            With shp

                .Top = cel.Offset(0, 1).Value

                .Left = cel.Offset(0, 2).Value

                .Height = cel.Offset(0, 3).Value

                .Width = cel.Offset(0, 4).Value

            End With

        End With

    Next cel

End Sub

Answer 2

dear Ossiemac,

thank you very much for your valuable feedback 

i tried the code.

it works fine.

Answer 3

Hi,

i think that this issue has been solved

in all office applications, after 2010 or 2013

(the moving shapes after hiding the row and then close the workbook)

if you have a shape 'in' a cell, via a vba macro.