问题描述
我有一个Excel工作簿,女巫使用activeX组合框来运行VBA代码。在大多数PC上都可以正常工作。
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):
这里是代码-恐怕它调用了3个子程序,它们都很长:
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
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
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?
干杯!
推荐答案
为了完整起见,这是对我有用的解决方案。
我改写了。
For the sake of completeness here is the solution that worked for me.I adapted the code from enderland.
如@Oliver Humphreys的评论中所述,这似乎与不同的屏幕分辨率有关。我使用以下cmd命令在许多具有不同版本Excel的不同计算机上进行了测试,以验证测试计算机的屏幕尺寸。
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
具有相同尺寸的计算机对ActiveX double-没有问题,图片。不论Excel版本或32/64位版本,那些尺寸不同的文件都可以。
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.
我已经修改了源代码以循环每个工作表并写出每个ActiveX对象的设置,到文本文件,在每个对象的详细信息之间留有空格。
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.
我将此代码放在我使用的开发计算机上的标准模块中,并从那里。从理论上讲,您可以在单个计算机上运行此操作,在其中创建特定尺寸的ActiveX对象,然后使用这些尺寸。
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.
然后我使用输出信息进行设置 Workbook_Open
事件。在这种情况下,我将设置所有ActiveX控件的属性。而且,不再需要双重图像,该对象将按预期运行。用户版本仅包含Workbook_Open代码。
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.
将 Workbook_Open
代码保留在分布式工作簿中的原因是
The reason for leaving the Workbook_Open
code in the distributed workbooks is in case of onward distribution.
获取现有尺寸的代码:
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
示例 Workbook_Open
事件代码:
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
或者,切换到表单控件。
Alternatively, switch to form controls.
这篇关于Excel组合框在某些PC上会加倍的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!