Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extended DataValidation Dropdown Listbox - Object Creation/Inherit
I'm a casual user of VBA and in this case I think I've got an issue that I
just don't have enough knowledge to address. So here I am asking for some help. I'm attempting to implement some VBA code that extends the width of a data validation list's dropdown listbox. Credit for the original code goes to Colo's Excel Junk room, at http://puremis.net/excel/code/068.shtml. My version is very slightly modified. I can get the code to work, albeit it seems a bit unstable if I don't delete and re-create my data validation definitions on closing and opeing the workbook. But my problem is that sometimes the way Excel acts with the data validation dropdown box just changes, and it can't be changed back to working correctly without reconstructing the workbook from scratch. As one moves across an Excel row, the extended datavalidation listbox routine gets run in the worksheet_selectionchange procedure if a cell has a datavalidation object attached to it. Normally, when the program returns from the extended data validation listbox routine one sees what the dropdown icon next to the activecell, and if you click on the dropdown the dropdown listbox itself will be the width in points that I allocate to it. Now the cell is ready for input. If I make a selection from the dropdown list, the cell will be updated and I can also make other updates to other cells in the active Excel row based on the selection made in the dropdown listbox (using the worksheet_change procedure). This will work fine, perhaps for several days. But then, all of a sudden, when I try to update ANY cell on the active Excel row from an entry made with the data validation dropdown listbox, the program aborts with a 1004 error message (Application defined or object defined error). Mind you, I can still edit the data validation cell directly and Excel will allow updates to the row. But no update from the extended data validation dropdown listbox. Also, if I put cell "updating" code into the worksheet_selection change procedure of the next cell in the row, Excel will allow updating to other cells in the row. Its as if the data validation drop down list receives the focus/acts as an acti ve application and Excel can't do anything again until I click on the Excel interface to reactivate the Excel application. So I've got to believe that this problem has something to do with the extended datavalidation listbox routine and how it's manipulating the datavalidation listbox. If anyone has any suggestions I'm all ears. Any help or suggestions would be appreciated. I've included the pertinent code below: ===================== Sub MakeValidationWidthWide(ByVal Target As Range, Optional DesiredWidth) 'This procedure widens Data Validation dropdown listboxes. It never 'lets the width of the Data Validation dropdown listbox be made 'shorter than the width of the cell to which the Data Validation 'object is attached. ' 'Parameters: ' Target A single cell range ' DesiredWidth The desired width of the data validation ' dropdown list box in points. ' Dim wks As Worksheet Dim elmDic As Object Dim elmShp As Shape Dim drpShp As Shape Dim objDic As Object Dim currentFilterRange As String Dim FilterArray() Dim AutoFilterFlag As Boolean Dim f As Integer Dim Col As Integer Dim RelativeToOriginalSize As Double 'a ratio relative to original width 'Invoke error trapping 10 On Error GoTo MakeValidationWidthWide_Error 20 Set wks = Target.Parent 30 On Error GoTo Terminate 40 If Target.Cells.Count 1 Then Exit Sub 50 If Target.Validation.Type = xlValidateList Then 'Save worksheet autofilter settings - This approach will not work if 'the worksheet is utilizing an autofilter. Check for autofilter and 'save settings if autofilter is on. Restore the settings later. 60 If wks.AutoFilterMode = True Then 70 AutoFilterFlag = True 80 With wks.AutoFilter 90 currentFilterRange = .Range.Address 100 With .Filters 110 ReDim FilterArray(1 To .Count, 1 To 3) 120 For f = 1 To .Count 130 With .Item(f) 140 If .On Then 150 FilterArray(f, 1) = .Criteria1 160 If .Operator Then 170 FilterArray(f, 2) = .Operator 180 FilterArray(f, 3) = .Criteria2 190 End If 200 End If 210 End With 220 Next 230 End With 240 End With 250 wks.AutoFilterMode = False 260 End If 'Caluculate the RelativeToOriginalSize ratio 270 If IsMissing(DesiredWidth) Then 280 RelativeToOriginalSize = 1 290 Else 300 If DesiredWidth (Target.Width + 10.25) Then 310 RelativeToOriginalSize = DesiredWidth / (Target.Width + 10.25) 320 Else 330 RelativeToOriginalSize = 1 340 End If 350 End If 'Create the Dictionary Object and enter DataValidation dropdown 'object into the Dictionary 360 Set objDic = CreateObject("Scripting.Dictionary") 370 For Each elmDic In wks.DrawingObjects 380 objDic.Add elmDic.Name, elmDic.Name 390 Next 400 For Each elmShp In wks.Shapes 410 If elmShp.Name Like "Drop Down *" Then 420 If Not objDic.Exists(elmShp.Name) Then 430 Set drpShp = elmShp 440 Exit For 450 End If 460 End If 470 Next 'Resize the Dictionary Object DataValidation dropdown listbox 480 If Not drpShp Is Nothing Then 'Adjust top for Excel rows with a height less than 15 490 If Target.Height < 15 Then drpShp.IncrementTop - 4.5 'Proportionally resize the DataValidation Object 500 drpShp.ScaleWidth RelativeToOriginalSize, False, msoScaleFromBottomRight 'SendKeys "%{down}" 510 End If 'Restore worksheet autofilter settings 520 If AutoFilterFlag Then 530 wks.Range(currentFilterRange).AutoFilter 540 For Col = 1 To UBound(FilterArray(), 1) 550 If Not IsEmpty(FilterArray(Col, 1)) Then 560 If FilterArray(Col, 2) Then 570 wks.Range(currentFilterRange).AutoFilter field:=Col, _ Criteria1:=FilterArray(Col, 1), _ Operator:=FilterArray(Col, 2), _ Criteria2:=FilterArray(Col, 3) 580 Else 590 wks.Range(currentFilterRange).AutoFilter field:=Col, _ Criteria1:=FilterArray(Col, 1) 600 End If 610 End If 620 Next 630 End If 640 End If Terminate: 650 Set wks = Nothing 660 Set drpShp = Nothing 670 Set objDic = Nothing 680 On Error GoTo 0 690 Exit Sub MakeValidationWidthWide_Error: 700 MsgBox "Error! Line: " & Erl & " No: " & Err.Number & " (" & Err.Description & ") in procedure MakeValidationWidthWide of Module modTimeTrack" 710 GoTo Terminate End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extended DataValidation Dropdown Listbox - Object Creation/Inherit
Update:
Further research on the internet indicates that this problem may not have anything to do with the extended dropdown code I've posted, but rather may well be a bug in the general data validation dropdown code in Excel (or more precisely forms handling code). I've come across several posts about problems with updating an Excel sheet from the worksheet_change event when utilizing a data validation dropdown listbox as the source of a cell's data. In these cases the underlying symptoms are the same as mine, except I probably have an added layer of results due to the manipulation of the width of the data validation dropdown listbox. In any event, the cases I found always end end up with the worksheet in question being unrecoverable. The code involved can be copied to a new worksheet, and it will work just fine - but it never works again in the original worksheet. Additionally, if you simultaneously open the old corrupted sheet while the new uncorrupted sheet is open, the new uncorrupted worksheet will stop working. Once you close the old corrupted worksheet, the new uncorrupted worksheet will start working again. This makes me think that that whatever settings are causing this affect are in fact being maintained in a 'common area' outside of Excel itself, somewhere else within the operating system memory or module storage. I'm tending to think there is a problem here in the Excel interface with Windows vis-a-vis handling dialog forms and/or their constituent components. Similar problems have been noted by individuals utilizing several forms in an Excel workbook. "phillfri" wrote: I'm a casual user of VBA and in this case I think I've got an issue that I just don't have enough knowledge to address. So here I am asking for some help. I'm attempting to implement some VBA code that extends the width of a data validation list's dropdown listbox. Credit for the original code goes to Colo's Excel Junk room, at http://puremis.net/excel/code/068.shtml. My version is very slightly modified. I can get the code to work, albeit it seems a bit unstable if I don't delete and re-create my data validation definitions on closing and opeing the workbook. But my problem is that sometimes the way Excel acts with the data validation dropdown box just changes, and it can't be changed back to working correctly without reconstructing the workbook from scratch. As one moves across an Excel row, the extended datavalidation listbox routine gets run in the worksheet_selectionchange procedure if a cell has a datavalidation object attached to it. Normally, when the program returns from the extended data validation listbox routine one sees what the dropdown icon next to the activecell, and if you click on the dropdown the dropdown listbox itself will be the width in points that I allocate to it. Now the cell is ready for input. If I make a selection from the dropdown list, the cell will be updated and I can also make other updates to other cells in the active Excel row based on the selection made in the dropdown listbox (using the worksheet_change procedure). This will work fine, perhaps for several days. But then, all of a sudden, when I try to update ANY cell on the active Excel row from an entry made with the data validation dropdown listbox, the program aborts with a 1004 error message (Application defined or object defined error). Mind you, I can still edit the data validation cell directly and Excel will allow updates to the row. But no update from the extended data validation dropdown listbox. Also, if I put cell "updating" code into the worksheet_selection change procedure of the next cell in the row, Excel will allow updating to other cells in the row. Its as if the data validation drop down list receives the focus/acts as an acti ve application and Excel can't do anything again until I click on the Excel interface to reactivate the Excel application. So I've got to believe that this problem has something to do with the extended datavalidation listbox routine and how it's manipulating the datavalidation listbox. If anyone has any suggestions I'm all ears. Any help or suggestions would be appreciated. I've included the pertinent code below: ===================== Sub MakeValidationWidthWide(ByVal Target As Range, Optional DesiredWidth) 'This procedure widens Data Validation dropdown listboxes. It never 'lets the width of the Data Validation dropdown listbox be made 'shorter than the width of the cell to which the Data Validation 'object is attached. ' 'Parameters: ' Target A single cell range ' DesiredWidth The desired width of the data validation ' dropdown list box in points. ' Dim wks As Worksheet Dim elmDic As Object Dim elmShp As Shape Dim drpShp As Shape Dim objDic As Object Dim currentFilterRange As String Dim FilterArray() Dim AutoFilterFlag As Boolean Dim f As Integer Dim Col As Integer Dim RelativeToOriginalSize As Double 'a ratio relative to original width 'Invoke error trapping 10 On Error GoTo MakeValidationWidthWide_Error 20 Set wks = Target.Parent 30 On Error GoTo Terminate 40 If Target.Cells.Count 1 Then Exit Sub 50 If Target.Validation.Type = xlValidateList Then 'Save worksheet autofilter settings - This approach will not work if 'the worksheet is utilizing an autofilter. Check for autofilter and 'save settings if autofilter is on. Restore the settings later. 60 If wks.AutoFilterMode = True Then 70 AutoFilterFlag = True 80 With wks.AutoFilter 90 currentFilterRange = .Range.Address 100 With .Filters 110 ReDim FilterArray(1 To .Count, 1 To 3) 120 For f = 1 To .Count 130 With .Item(f) 140 If .On Then 150 FilterArray(f, 1) = .Criteria1 160 If .Operator Then 170 FilterArray(f, 2) = .Operator 180 FilterArray(f, 3) = .Criteria2 190 End If 200 End If 210 End With 220 Next 230 End With 240 End With 250 wks.AutoFilterMode = False 260 End If 'Caluculate the RelativeToOriginalSize ratio 270 If IsMissing(DesiredWidth) Then 280 RelativeToOriginalSize = 1 290 Else 300 If DesiredWidth (Target.Width + 10.25) Then 310 RelativeToOriginalSize = DesiredWidth / (Target.Width + 10.25) 320 Else 330 RelativeToOriginalSize = 1 340 End If 350 End If 'Create the Dictionary Object and enter DataValidation dropdown 'object into the Dictionary 360 Set objDic = CreateObject("Scripting.Dictionary") 370 For Each elmDic In wks.DrawingObjects 380 objDic.Add elmDic.Name, elmDic.Name 390 Next 400 For Each elmShp In wks.Shapes 410 If elmShp.Name Like "Drop Down *" Then 420 If Not objDic.Exists(elmShp.Name) Then 430 Set drpShp = elmShp 440 Exit For 450 End If 460 End If 470 Next 'Resize the Dictionary Object DataValidation dropdown listbox 480 If Not drpShp Is Nothing Then 'Adjust top for Excel rows with a height less than 15 490 If Target.Height < 15 Then drpShp.IncrementTop - 4.5 'Proportionally resize the DataValidation Object 500 drpShp.ScaleWidth RelativeToOriginalSize, False, msoScaleFromBottomRight 'SendKeys "%{down}" 510 End If 'Restore worksheet autofilter settings 520 If AutoFilterFlag Then 530 wks.Range(currentFilterRange).AutoFilter 540 For Col = 1 To UBound(FilterArray(), 1) 550 If Not IsEmpty(FilterArray(Col, 1)) Then 560 If FilterArray(Col, 2) Then 570 wks.Range(currentFilterRange).AutoFilter field:=Col, _ Criteria1:=FilterArray(Col, 1), _ Operator:=FilterArray(Col, 2), _ Criteria2:=FilterArray(Col, 3) 580 Else 590 wks.Range(currentFilterRange).AutoFilter field:=Col, _ Criteria1:=FilterArray(Col, 1) 600 End If 610 End If 620 Next 630 End If 640 End If Terminate: 650 Set wks = Nothing 660 Set drpShp = Nothing 670 Set objDic = Nothing 680 On Error GoTo 0 690 Exit Sub MakeValidationWidthWide_Error: 700 MsgBox "Error! Line: " & Erl & " No: " & Err.Number & " (" & Err.Description & ") in procedure MakeValidationWidthWide of Module modTimeTrack" 710 GoTo Terminate End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Select Multiple Items and return value for Dropdown or listbox | Excel Discussion (Misc queries) | |||
How do i set up a dropdown listbox of values in a column of cells | Excel Worksheet Functions | |||
Object creation | Excel Programming | |||
Object Creation | Excel Programming | |||
Manual sequence to add a combobox/dropdown/listbox to toolbar | Excel Programming |