I have a bunch of comboboxes to set up and was trying to use a sub because of it just being a repeat function for each combobox. Each combobox will have 0 to up to 15 (just numbers) in it.
I have used this type of code before and it worked. Not sure what I am doing wrong this time.
'''
'Call FillInCombobox(4, CB_TSM.Name)'
' '
'Sub FillInCombobox(Num as long,CB_Name as String)'
'Dim NameCB as Combobox'
'Dim x as Integer'
' Set NameCB = .Controls.Item(CB_Name)'
'With NameCB'
' .clear'
' For x = 0 to Num'
' NameCB.Additem x'
' Next x'
'End with'
'End sub'
'''
When I step through the program it stops at 'Set NameCB = .Control.Item(CB_Name)'. And the error it has is 'Run-time error '91': Object variable or With block variable not set.'
Related
I am trying to open a form and move to last record.
I am using the following
DoCmd.RunCommand acCmdRecordsGoToLast
The form open and go to last record, but it is hiding the other records(I must use the scroll bar). This might confuse users that there are no other records.
Is it possible to go to last record and have visible the 10 last records?
It's your lucky day - this is surprisingly non-trivial, and I have written a function for this purpose some time ago.
'---------------------------------------------------------------------------------------
' Procedure : FormGotoEnd
' Author : Andre
' Purpose : Go to the last record of a continuous form, but don't scroll that record to the top
' (as DoCmd.RunCommand acCmdRecordsGoToLast would do).
' Instead scroll up so that the last record is visible at the bottom of the form.
' Parameters: F = the form, can be a subform
' AddtlEmptyRowsBottom = if you want to have room for more than one empty row, for data entry forms
'
' Call this sub e.g. in Form_Load() or in Form_Current of the parent form, like this:
' Call FormGotoEnd(Me)
' or Call FormGotoEnd(Me!SubformControl.Form, 3)
'---------------------------------------------------------------------------------------
'
Public Sub FormGotoEnd(F As Form, Optional AddtlEmptyRowsBottom As Long = 0)
Dim DetailSectionHeight As Long
Dim nVisible As Long
Dim nRecords As Long
On Error GoTo FormGotoEnd_Error
' Calculate height of full details section: Window height minus header+footer
DetailSectionHeight = F.InsideHeight
' Ignore errors if form has no header or footer
On Error Resume Next
If F.Section(acHeader).Visible Then
DetailSectionHeight = DetailSectionHeight - F.Section(acHeader).Height
End If
If F.Section(acFooter).Visible Then
DetailSectionHeight = DetailSectionHeight - F.Section(acFooter).Height
End If
On Error GoTo FormGotoEnd_Error
' Number of visible records in details section
nVisible = CLng(DetailSectionHeight / F.Section(acDetail).Height)
' Nothing to do if the form has no records
If F.RecordsetClone.RecordCount > 0 Then
' For complex record source and/or many records, Access may not know .RecordCount yet
' -> calculate via .MoveLast
F.RecordsetClone.MoveLast
nRecords = F.RecordsetClone.RecordCount
' Nothing to do if all records are visible
If nRecords > nVisible Then
' Move to last record. Use .Bookmark so the subform doesn't need to get focus
F.Bookmark = F.RecordsetClone.Bookmark
' This is the important part!
' Add 2 to AddtlEmptyRowsBottom, in order to see the empty data-entry record plus one empty line
F.SelTop = nRecords - nVisible + 2 + AddtlEmptyRowsBottom
' Make sure the last record is selected
F.Bookmark = F.RecordsetClone.Bookmark
End If
End If
FormGotoEnd_Exit:
On Error GoTo 0
Exit Sub
FormGotoEnd_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in FormGotoEnd", vbExclamation
Resume FormGotoEnd_Exit
End Sub
I'm having a 1004 error in the code below. Its such as simple routine, I can't figure out what's wrong. This is only one sub of many in Module 1. Note that UserForm2's code works fine when I run it from the forms Sub's. But when I call it from here, I get the 1004 error. I don't really understand what causes that error. Help appreciated. Note that ChosenString and Report is a Public variable. You have several 1004 error entries, but I can't find one that fits this problem. Error is on UserForm2.Show.
Sub ChooseReport()
' Display a selection box of reports and run the report
'
ChoseCancel = 0
Sheets("Codes").Activate
UserForm2.Show ' Displays selection box of reports
'
' If the Cancel button was selected, exit the sub
If ChoseCancel = 1 Then
Sheets("Reports").Activate
Exit Sub
End If
'
' Trim returned value of the comma
StringLength = Len(ChosenString)
Report = Left(ChosenString, StringLength - 2)
'
End Sub
This is my UserForm2 Code. It works fine.
Sub UserForm_Initialize()
' Fill the list box with appropriate values
'
UserForm1.ListBox1.ListStyle = fmListStylePlain
Sheets("Codes").Activate
Range("O4").Select
'
' Fill List box with appropriate cells entries for Reports
With ListBox1
Do While ActiveCell.Value <> Empty
.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End With
End Sub
Found it. I had copied the code from UserForm1, and hadn't changed a reference to UserForm1 to UserForm2. My error went away.
I'm trying to write a small VBA-Macro to tidy up a huge word file with a bunch of pictures (>100) by making sure they are all normal shapes (not inline) and have a caption associated with them. Further the caption and the picture need to be grouped together to make re-arranging them easier.
I do however run into problems when running the code. After creating a "shaperange" the "group" method crashes (Set shpGroup = ShpRng.Group) with a runtime error "'-2147024891 (8000700005)': The grouping of selected forms is disabled"
Here's my code:
Sub PicFix()
'
' For a selected picture, convert it to a normal image (not inline),
' add acaption to it, then group the image and its caption
'
Dim sCaption As String
Dim shpIn As InlineShape
Dim shpPic, shpCap, shpGroup As Shape
Dim ShpRng As ShapeRange
Dim sNamePic, sNameCap As String
Dim iZOrder As Integer
'First of all get hold of the shape and assign it to the SHP object
' In case it is an inline shape, converted to a normal shape
If Selection.InlineShapes.Count > 0 Then
Set shpIn = Selection.InlineShapes(1)
Set shpPic = shpIn.ConvertToShape
Else
Set shpPic = Selection.ShapeRange(1)
End If
' Second, fetch the caption text from the clipboard
' sCaption = GetClipBoardText()
' For debugging purpose....
sCaption = "This is a dummy caption" ' Just assign a dummy caption string
' now start to "fix" the selected picture...
shpPic.Select
iZOrder = shpPic.ZOrderPosition
sNamePic = "Pic_" + CStr(iZOrder)
shpPic.Name = sNamePic ' Give this object a name. Use the ZOrderPosition as a name as it is unique within the documnet
' (but might change as new shapes etc. are addedd to the document - but, best I can do)
shpPic.WrapFormat.Type = wdWrapSquare ' Make the text wraps around all sides
If sCaption > "" Then
shpPic.Select ' make sure the picture is selected before adding the caption below it
Selection.InsertCaption Label:="Figure", TitleAutoText:="", Title:=": " + sCaption, Position:=wdCaptionPositionBelow
' Now the selected object has changed from the picture to the new caption
Set shpCap = Selection.ShapeRange(1)
sNameCap = "Cap_" + CStr(iZOrder) ' Give the caption object a name as well
shpCap.Name = sNameCap
Debug.Print "ShapeNames: shpPic=" + shpPic.Name + "; shpCap=" + shpCap.Name
Debug.Print "ShapeTypes: shpPic=" + CStr(shpPic.Type) + "; shpCap=" + CStr(shpCap.Type) ' 13=Picture; 17=TextBox
' Here is the tricky bit ... group the picture and its caption ...
' create a shaperange containing the two objects, then group them
Set ShpRng = ActiveDocument.Shapes.Range(Array(sNamePic, sNameCap))
Set shpGroup = ShpRng.Group ' <<<<------ This is where it crashes :
' runtime Error: Grouping of selected objects (or forms) is disabled
shpGroup.Select ' Make sure it is selected
shpGroup.WrapFormat = wdWrapSquare ' Make the text wraps around all sides
End If
End Sub
Any idea what I'm doing wrong?
The problem has to do with the caption being selected (or in edit mode or something).
You can work around this issue by selecting something else before the problem code.
' Following added to workaround error when caption is selected.
shpPic.Select
Set shpGroup = ShpRng.Group ' <<<<------ This is where it crashes :
Note that you get an error with the last line once you solve this problem. You should change it to:
shpGroup.WrapFormat.Type = wdWrapSquare ' Make the text wraps around all sides
In a dropdown list I have a few items. Can I, when I select an item, get the position of that item in the list as a number?
If you are looking for the index of a Data Validation list, this is what I'd do:
Put the following code in the ThisWorkbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ValidationIndex As Long
Dim rngTest As Excel.Range
'assumes the data validation is in a cell named "rngTest"
On Error Resume Next
Set rngTest = Sh.Range("rngTest")
If rngTest Is Nothing Then
Exit Sub
End If
On Error GoTo 0
If Not Intersect(ActiveCell, Sh.Range("rngTest")) Is Nothing Then
ValidationIndex = GetValidationIndex
MsgBox ValidationIndex
End If
End Sub
Put this function in the ThisWorkbook module also, or else in any regular module:
Function GetValidationIndex() As Long
'returns a 1-based index
Dim rngTest As Excel.Range
Dim varValidationString As Variant
Dim ErrNumber As Long
Dim i As Long
With ActiveCell.Validation
If .Type = xlValidateList Then '3
On Error Resume Next
Set rngTest = ActiveCell.Parent.Range(.Formula1)
'I do this goofy thing with ErrNumber to keep my indenting and flow pretty
ErrNumber = Err.Number
On Error GoTo 0
'if the Validation is defined as a range
If ErrNumber = 0 Then
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
Exit Function
'if the validation is defined by comma-separated values
Else
varValidationString = Split(.Formula1, ",")
For i = LBound(varValidationString) To UBound(varValidationString)
If varValidationString(i) = ActiveCell.Value2 Then
GetValidationIndex = i + 1
Exit Function
End If
Next i
End If
End If
End With
End Function
If you are using a list or combo box, ListIndex would seem to be what you are after.
VB Help for ListIndex property: Returns or sets the index number of the currently selected item in a list box or combo box. Read/write Long. Remarks. You cannot use this property with multiselect list boxes.
If nothing is selected, ListIndex's value is -1. If memory serves, it is a zero based index.
ListIndex cannot be set at design time so it is not listed in the properties window.
When entering your code, type the list box name then dot and the editor displays all the available properties. Scroll down the list, note any that look interesting, then look them up.
I think it is not necessary to use a function. You can get it by using only Match function, like in above Doug's answer.
Dim GetValidationIndex as Integer
Dim rngTest as Range
' Get the validation list
With ActiveCell.Validation
Set rngTest = ActiveCell.Parent.Range(.Formula1)
end with
GetValidationIndex = Application.WorksheetFunction.Match(ActiveCell.Value2, rngTest, 0)
The function GetValidationIndex is good.
However, for some regional settings the line varValidationString = Split(.Formula1, ",") is not valid, because the character used to separate the different values is ";"
I suggest use:
varValidationString = Split(.Formula1, Application.International(xlListSeparator))
I am writing a reporting tool to document Excel files for various "compliance criteria", including wkb.VBProject.Protection to report if the VBA is locked.
But how can I find if the workbook HAS any project ?
If I calculate
wkb.VBProject.VBComponents.Count - wkb.Worksheets.Count - 1 '(for the workbook)
that will give me the number of modules + class modules + forms, but I could still have some code behind a sheet.
Is there a way in Excel - like Access frm.HasModule - to find out if there's any VBA code in the workbook ?
Excel 2007+ has a new workbook property called ".HasVBProject" that you can enquire.
For Excel 2003 and earlier the above solution testing for lines of code in the CodeModule of any of the VBComponents of the workbook is appropriate.
You should test the ".CountOfLines" property all alone, since lines of code in the Declaration section of a code module (obtained via ".CountOfDeclarationLines") are considered by Excel as "Macro code" and require saving to macro-enabled formats.
Public Function HasVBProject(Optional pWorkbook As Workbook) As Boolean
'
' Checks if the workbook contains a VBProject.
'
On Error Resume Next
Dim wWorkbook As Workbook
Dim wVBComponent As VBIDE.VBComponent ' As Object if used with Late Binding
' Default.
'
HasVBProject = False
' Use a specific workbook if specified, otherwise use current.
'
If pWorkbook Is Nothing _
Then Set wWorkbook = ActiveWorkbook _
Else Set wWorkbook = pWorkbook
If wWorkbook Is Nothing Then GoTo EndFunction
If (VBA.CInt(Application.Version) >= 12) _
Then
' The next method only works for Excel 2007+
'
HasVBProject = wWorkbook.HasVBProject
Else
' Signs the workbook has a VBProject is code in any of the VBComponents that make up this workbook.
'
For Each wVBComponent In wWorkbook.VBProject.VBComponents
If (wVBComponent.CodeModule.CountOfLines > 0) _
Then
' Found a sign of programmer's activity. Mark and quit.
'
HasVBProject = True: Exit For
End If
Next wVBComponent
End If
EndFunction:
Set wVBComponent = Nothing
Set wWorkbook = Nothing
End Function
Dutch
I've used the following to count the total number of lines in a project before. It will pick up code in ThisWorkbook, code modules, class modules and forms.
Private Sub countCodeLines()
Dim obj As Object
Dim VBALineCount As Long
For Each obj In ThisWorkbook.VBProject.VBComponents
VBALineCount = VBALineCount + obj.CodeModule.CountOfLines
Next obj
Debug.Print VBALineCount
End Sub
Note however that if your workbooks have Option Explicit forced then this will count as two lines per object (Option Explicit and a line feed). If you know this to be the case, and are checking the LOC from another project, then you could simply count the number of objects, double it and test that VBALineCount does not exceed this number.
After Lunatik's hint, here's my final function (for whom it may help):
Function fTest4Code(wkb As Workbook) As Boolean
'returns true if wkb contains VBA code, false otherwise
Dim obj As Object
Dim iCount As Integer
For Each obj In wkb.VBProject.VBComponents
With obj.CodeModule
'# lines - # declaration lines > 2 means we do have code
iCount = iCount + ((.CountOfLines - .CountOfDeclarationLines) > 2)
End With
If iCount 0 Then Exit For 'stop when 1st found
Next obj
fTest4Code = CBool(iCount)
End Function