27424

Excel Comboboxes double up on some PCs

Question:

I've got an excel workbook witch uses activeX comboboxes to run VBA code. It works fine on most PCs.

However some of my clients find that when they click on the comboboxes the combobox appears to double up or duplicate, one on top of the other. Also the doubled up drop down doesn't function.

Here's an example (bottom combobox displays the issue):

<a href="https://i.stack.imgur.com/UqoQm.png" rel="nofollow"><img alt="Doubled up combo box" class="b-lazy" data-src="https://i.stack.imgur.com/UqoQm.png" data-original="https://i.stack.imgur.com/UqoQm.png" src="https://etrip.eimg.top/images/2019/05/07/timg.gif" /></a>

Here's the code - I'm afraid it calls 3 subroutines which are all quite lengthy:

Private Sub SegmentComboBox_Change() Call DrawTabCCView PopTab Call CCViewAddFormulasNew End Sub

DrawTabCCView

Sub DrawTabCCView() Dim C As Range Dim D As Range Dim D2 As Range Dim CountryCol As Integer Dim SegDetCol As Integer Dim CompetitionCol As Integer Dim BrandCol As Integer Dim CompCol As Integer Dim TotX As Range, Comp As Range Dim PrevLabel As String Application.ScreenUpdating = False ThisWorkbook.Sheets("Country_Category view").Activate 'clear old data Set D = ActiveSheet.Range("C13") If D.Value <> "Total Category" Then Stop Do Until D.Value = "" And D.End(xlDown) = "" Select Case D.Value Case "Total Category", "Total", "Private Labels", "Competition" PrevLabel = D.Value D.EntireRow.ClearContents D.Value = PrevLabel If D.Value = "Total Category" Then Set TotCat = D ElseIf D.Value = "Total" Then Set TotX = D ElseIf D.Value = "Private Labels" Then Set PL = D ElseIf D.Value = "Competition" Then Set Comp = D End If Case "" 'do nothing Case Else If D.Offset(-2, 0) <> "" Then D.EntireRow.ClearContents Else Set D = D.Offset(-1, 0) D(2, 1).EntireRow.Delete End If End Select Set D = D.Offset(1, 0) Loop Set C = ThisWorkbook.Sheets("Raw Data (2)").Cells(1, 1) Do Until C.Value = "" If C.Value = "Country" Then CountryCol = C.Column If C.Value = "Segment + Detail" Then SegDetCol = C.Column If C.Value = "Competition" Then CompetitionCol = C.Column If C.Value = "Local_Brand_Name" Then BrandCol = C.Column If C.Value = "Competition" Then CompCol = C.Column Set C = C.Offset(0, 1) Loop If CountryCol = 0 Then Stop If SegDetCol = 0 Then Stop If CompetitionCol = 0 Then Stop Set C = C.Parent.Cells(2, 1) Do Until C.Value = "" If C(1, CountryCol).Value = ActiveSheet.CountryComboBox.Value And C(1, SegDetCol).Value = ActiveSheet.SegmentComboBox.Value Then Select Case C(1, BrandCol) Case "Total Category", "Private Labels", "Total", "Dummy" 'do nothing Case Else If C(1, CompCol) = "XXX" Then Set D = TotX.Offset(2, 0) ElseIf C(1, CompCol) = "Competition" Then Set D = Comp.Offset(2, 0) Else Stop End If Do Until D.Value = "" Set D = D.Offset(1, 0) Loop If D.Offset(-1, 0).Value <> "" Then D.EntireRow.Insert Set D = D.Offset(-1, 0) End If D.Value = C(1, BrandCol).Value End Select End If Set C = C.Offset(1, 0) Loop Application.ScreenUpdating = True End Sub

PopTab

Sub PopTab() Call PopulateTables(ThisWorkbook.ActiveSheet) ActiveSheet.Range("A1").Activate End Sub

CCViewAddFormulasNew

Sub CCViewAddFormulasNew() Dim D As Range Dim D2 As Range Dim TabFilter(1 To 2, 4) As Variant TabFilter(1, 0) = "Measure" TabFilter(1, 1) = "Country" TabFilter(1, 2) = "Segment + Detail" TabFilter(1, 3) = "Period" TabFilter(1, 4) = "Local_Brand_Name" TabFilter(2, 0) = "XXX" TabFilter(2, 1) = ActiveSheet.CountryComboBox.Value TabFilter(2, 2) = ActiveSheet.SegmentComboBox.Value TabFilter(2, 3) = "XXX" TabFilter(2, 4) = "XXX" Application.ScreenUpdating = False If DontUpdate = False Then 'Stop Set D = ThisWorkbook.Sheets("Country_Category view").Range("C13") Do Until D.Value = "" And D.End(xlDown).Value = "" If D.Value <> "" Then Set D2 = D(1, 3) 'brand TabFilter(2, 4) = D.Value Do Until D2.Parent.Cells(11, D2.Column) = "" And D2.Parent.Cells(11, D2.Column + 1) = "" TabFilter(1, 0) = D2.Parent.Cells(10, D2.Column).Value TabFilter(2, 3) = D2.Parent.Cells(11, D2.Column).Value D2.Value = FindValPivot(ThisWorkbook.Sheets("Raw Data"), TabFilter()) TabFilter(2, 3) = D2.Parent.Cells(11, D2.Column + 1).Value D2(1, 2).Value = FindValPivot(ThisWorkbook.Sheets("Raw Data"), TabFilter()) If D2.Value <> "" And D2(1, 2).Value <> "" Then D2(1, 3).FormulaR1C1 = "=RC[-1]/RC[-2] * 100" End If If IsError(D2(1, 3).Value) Then D2(1, 3).Value = "n/a" Set D2 = D2.Offset(0, 4) Loop End If Set D = D.Offset(1, 0) Loop End If Application.ScreenUpdating = True ActiveSheet.Range("A1").Activate End Sub

Any idea how to stop this happening?

Cheers!

Answer1:

For the sake of completeness here is the solution that worked for me. I adapted the code from <a href="http://%20%20%20%20'%20https://stackoverflow.com/questions/19385803/how-to-stop-activex-objects-automatically-changing-size-in-office" rel="nofollow">enderland</a>.

As noted in comments by @Oliver Humphreys, this seems to be related to differing screen resolutions. I tested on a number of different machines, with different versions of Excel, using the following cmd command to verify test machines screen dimensions.

wmic desktopmonitor get screenheight, screenwidth

The machines with the same dimensions showed no problem with the ActiveX double-image. Those with differing dimensions did, irrespective of Excel version or 32/64 bit.

I have adapted the source code to loop each sheet and write out the settings of each ActiveX object, to a text file, with a space in between each object's details.

I put this code in a standard module, on the development machine I use, and ran it from there. You could in theory run this on individual machines, where you create an ActiveX object of particular dimensions, and then use those dimensions.

I then used the output information to set up Workbook_Open event. In this event I set the properties for all the ActiveX controls. And voilà, no more double image and the object functions as expected. Users versions had only the Workbook_Open Code in.

The reason for leaving the Workbook_Open code in the distributed workbooks is in case of onward distribution.

Code to get existing dimensions:

Option Explicit Private Sub printAllActiveXSizeInformation() Dim myWS As Worksheet Dim OLEobj As OLEObject Dim obName As String Dim shName As String Dim mFile As String mFile = "C:\Users\yourusername\Desktop\ActiveXInfo.txt" Open mFile For Output As #1 For Each myWS In ThisWorkbook.Worksheets shName = myWS.Name With myWS For Each OLEobj In myWS.OLEObjects obName = OLEobj.Name Print #1, "'" + obName Print #1, shName + "." + obName + ".Left=" + CStr(OLEobj.Left) Print #1, shName + "." + obName + ".Width=" + CStr(OLEobj.Width) Print #1, shName + "." + obName + ".Height=" + CStr(OLEobj.Height) Print #1, shName + "." + obName + ".Top=" + CStr(OLEobj.Top) Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft" Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft" Print #1, vbNewLine Next OLEobj End With Next myWS Close #1 Shell "NotePad " + mFile End Sub

Example Workbook_Open event code:

Private Sub Workbook_Open() Dim wb As Workbook Dim ws as Worksheet Set wb = ThisWorkbook Set ws = wb.Worksheets("Sheet1") 'add more as appropriate With ws .OLEObjects("ComboBox1").Left = 269 .OLEObjects("ComboBox1").Width = 173 .OLEObjects("ComboBox1").Height = 52.5 .OLEObjects("ComboBox1").Top = 179.5 .Shapes("ComboBox1").ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft End With End Sub <hr />

Alternatively, switch to form controls.

Recommend

  • Code to hide only one workbook instead of hiding all currently open workbooks
  • macro that auto-executes when sheet is opened
  • Excel 2007 VBA Zooming (without using select?)
  • Why does not field with custom function to get name recalculate?
  • How to read a certificate from a USB token in C#
  • What is the use of the SHT_NULL section in ELF?
  • Align Excel cell to center VB - xlCenter is not declared
  • Can you render a page with multiple forms instead of one form for a jQuery, Rails 3 update?
  • @Autowired for @ModelAttribute
  • Django: ORDER BY DESC on FloatField puts null values top?
  • Laravel lmutator $this->attributes return 'Undefined index: id'
  • Angular2 ag-grid datasource not working
  • Is it mandatory to have a doGet or doPost method?
  • Creating My Symmetric Key in C#
  • How to set an entity field that does not exist on the table but does exists in the raw SQL as an ali
  • Count from each distinct date, fill in missing dates with zero
  • Where these are stored?
  • cell spacing in div table
  • LESS CSS how to modify parent property in mixin
  • Angular2 - Template reference inside NgSwitch
  • Using Generics on right hand side in Java 6?
  • Application level floating views with navigation in Android
  • How to add a focus style to an editable ComboBox in WPF
  • Web.config system.webserver errors
  • Force show.bind execution
  • Excel's Macro-Recorder usage
  • Groovy: Unexpected token “:”
  • How to change the font size of a single index for UISegmentedControl?
  • Replace value with Factor in r data.table
  • Disable Enter in editText android
  • How to access EntityManager inside Entity class in EJB3
  • Repeat a vertical line on every page in Report Builder / SSRS
  • Excel - Autoshape get it's name from cell (value)
  • vba code to select only visible cells in specific column except heading
  • embed rChart in Markdown
  • Linking SubReports Without LinkChild/LinkMaster
  • Easiest way to encapsulate a HTML5 webpage into an android app?
  • How to get NHibernate ISession to cache entity not retrieved by primary key
  • How can I use `wmic` in a Windows PE script?
  • Unable to use reactive element in my shiny app