Excel VBA Change Height and width of ListBox Programatically - vba

Sub add_ListBox()
Dim box As msforms.ListBox
Dim myBox As Object
For i = 0 To Select_Files.FileBox1.ListCount - 1
Set box = UserForm4.Controls.Add("Forms.ListBox.1", "tSourceBox" & i + 1, True)
Set myBox = box
With myBox
.ColumnCount = 2
.ColumnWidths = "0 pt;189 pt"
.IntegralHeight = True
.Top = 24
.Left = 6
.Height = 153
.Width = 189
End With
Next
End Sub
The above code suddenly stopped working properly, and I don't understand why. Initially, it was producing the ListBoxes with the specified height and width. However, all of a sudden when I run the code height and width are not what is specified in the code.
How can I make it so that I have control over the height and width of the ListBoxes?
Excel 2010 Windows 7 x64

There is a ListBox property called IntegralHeight for ActiveX and Forms. Set it to False.

Related

Text Alignment in VBA PowerPoint 2013

I have this code snippet which works fine, except for the last line when I try to align the text to the center. msoAlignRight was just for testing purposes to see if it moves to the right..but nothing happens. - edit: I have incorporated this from Qlikview to PPT macro, shouldn't matter though.
NOTE: I WOULD LIKE leText 0 to be centered text in the middle. Now it's to the left.
Sub ppt
'Set ppt template
filePath_template = "...\Template.pptx"
'Remove filters
ActiveDocument.ClearAll()
'Retrieve all accounts
set field1Values = ActiveDocument.Fields("name").GetPossibleValues
ActiveDocument.ActivateSheetByID "ABC01"
for i = 0 to 15
ActiveDocument.Fields("name").Clear
ActiveDocument.GetApplication.WaitForIdle 100
'Set filter on just 1 account
ActiveDocument.Fields("name").Select field1Values.Item(i).Text
ActiveDocument.GetApplication.Sleep 5000
ActiveDocument.GetApplication.WaitForIdle 100
'Create a ppt object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Open the ppt template
Set objPresentation = objPPT.Presentations.Open(filePath_template)
Set PPSlide = objPresentation.Slides(1)
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText2 = PPSlide.Shapes.Paste
leText2.Top = 280
leText2.Left = 310
leText2.Width = 300
leText2.TextFrame.TextRange.Font.Size = 8
ActiveDocument.GetApplication.Sleep 1000
for k = 0 to 10
ActiveDocument.GetApplication.WaitForIdle 100
ActiveDocument.ActiveSheet.CopyBitmapToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
next
ActiveDocument.GetApplication.WaitForIdle 100
'leText 0
ActiveDocument.GetSheetObject("TEXT002").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText0 = PPSlide.Shapes.Paste
leText0.Top = 1
leText0.Left = 150
leText0.Width = 700
leText0.TextFrame.TextRange.Font.Size = 12
leText0.TextFrame.TextRange.Font.Color = vbWhite
'Save ppt
filePath = "...\SaveFolder\" & field1Values.Item(i).Text & ".pptx"
objPresentation.SaveAs filePath
Next
objPPT.Quit
End Sub
Since the CopyTextToClipboard method is a QV API I'm not sure if the shape is being copied or the text within the shape (or TextRange). Try this: once the macro has created the shape leText0, select it in PowerPoint, set the justification to left and enter this command in the Immediate window:
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment=ppAlignCenter
Note that ppAlignCenter = 2
What happens?
If the API is copying just the text then I would have expected you would need to create the shape in PowerPoint first and then copy the text from the clipboard into the TextRange of the shape. To test this, replace these lines:
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
Set leText2 = PPSlide.Shapes.Paste
leText2.Top = 280
leText2.Left = 310
leText2.Width = 300
leText2.TextFrame.TextRange.Font.Size = 8
...with these:
'leText 2
ActiveDocument.GetSheetObject("TEXT001").CopyTextToClipboard
ActiveDocument.GetApplication.WaitForIdle 100
With PPSlide.Shapes.AddShape(msoShapeRectangle, 310, 280, 300, 0)
With .TextFrame
.WordWrap = msoFalse
.AutoSize = ppAutoSizeShapeToFitText
With .TextRange
.Paste
.ParagraphFormat.Alignment = ppAlignCenter
.Font.Size = 8
End With
End With
End With
Change the "Align right" line to :
leText.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
Another possible improvement to your piece of code, will be using With' like:
With leText
.Top = 12
.Left = 250
.Width = 500
.TextFrame.TextRange.Font.Size = 14
.TextFrame.TextRange.Font.Color = vbWhite
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
End With
What variable type have you declared leText as? It should be Shappe as you're processing a single object but the paste method will return an object of type ShapeRange so you could get the single Shape using this line:
Set leText = PPSlide.Shapes.Paste(1)
Also, if this code is running in Excel and you're using early binding, I assume you've set a reference to the PowerPoint library so that the ppAlignRight value is known, if using late binding you'll need to define it yourself.
Finally, for MSO 2007 and above I recommend using the newer TextFrame2 (and TextRange2) objects as they have more properties available from the updated graphics engine.

Could Not Set the Visible Property Error when Hiding a Frame

I'm having an issue in Excel 2007 VBA whereby I'm trying to set the visible property to false on a frame within a UserForm.
Userform1.Frame1.Visible = False
When trying to set the property, excel throws the error:
Run-time error '-2147418113 (8000ffff)':
Could not set the Visible property. Unexpected call to method or property access.
I've researched this and the only thing that I've uncovered is that it might be something to do with not having a control to take the focus. In my case this is not true though as there is a button available to take the focus on another frame. The other frame is set to be visible prior to Frame1 being hidden.
Has anyone else experienced this issue or can help me understand what is causing this error?
Edit - Code Addition
Public Sub fOpenFrame(uf As UserForm, strName As String)
Dim con As Control
Dim i As Long
i = 5
Application.ScreenUpdating = False
With uf.Controls(strName)
.Top = 38.15
.Left = 120
.Height = 400
.Width = 565
.Visible = True
End With
For Each con In uf.Controls
If TypeName(con) = "Frame" And con.Name <> strName And InStr(con.Name, "Menu") < 1 _
And con.Name <> "frmNewAbsenceButton" And con.Name <> "frmExistingAbsenceButton" Then
With con
.Visible = False 'Error occurs here'
.Top = 5
.Left = i
.Height = 20
.Width = 20
End With
i = i + 25
End If
Next con
Application.ScreenUpdating = True
End Sub
Edit 2 - Pictures Added
This is the first frame Frame1. A msgbox pops up and when the user clicks yes, it opens Frame2.
This is Frame2. This frame opens with all the textboxes / comboboxes disabled. The button control 'Edit' is enabled.
I'd prefer to make all frames invisible first (and not to care about their position nor size); after that the only relevant frame can be made visible.
If the sub is in the userform's macromodule you can use Me("Frame4") and refrain from the argument: 'uf as userform'.
Public Sub fOpenFrame(uf As UserForm, strName As String)
for each it in uf.controls
if typename(it)="Frame" then it.visible=false
next
With uf.Controls(strName)
.Top = 38.15
.Left = 120
.Height = 400
.Width = 565
.Visible = True
End With
End Sub
I have been having the same issue intermittently.
After reading the other answers, I added .setfocus call to a valid textbox before I the visible = false call, and it seemed to fix the issue.
With con
textbox1.setfocus 'Adding this seemed to fix the issue
.Visible = False 'Error occurs here'
.Top = 5
.Left = i
.Height = 20
.Width = 20
End With
I have tested in excel 2010 the the code is working fine(I don't have excel 2007)
Please try the below code.
Private Sub Frame1_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Me.Frame1.Visible = False
End Sub

removing controls added during run time

I have a userform that has a text box and whatever value is put into the textbox will determine the number of dynamic controls that are added to the user form and then there is a button and once that is clicked I want the dynamic controls to be removed from the userform altogether.
Below shows the code that is used to create the dynamic controls and this code works perfectly
For i = 1 To TextBox1.Value
newPosition = 360
Set cLabel = Me.Controls.Add("Forms.Label.1")
With cLabel
.Caption = "Label " & (i)
.Font.Size = 8
.Font.Bold = True
.Font.Name = "Tahoma"
'.Left = 70
.Left = 36
.Top = switchBoardLevel
.Width = 130
End With
switchBoardLevel = switchBoardLevel + newPosition
Set cButton = Me.Controls.Add("Forms.CommandButton.1")
With cButton
.Name = "CommandButton" & i
.Caption = "Calculate"
.Left = 300
.Top = buttonStartPosition
.Width = 45
.Height = 18
End With
ReDim Preserve TextListBox(1 To i)
Set TextListBox(i).ButtonGroup = cButton
buttonStartPosition = buttonStartPosition + newPosition
Next i
However there is a problem when it comes to removing the dynamically created controls. I have tried numerous ways to remove the controls. The code below is executed when the button is clicked to remove the controls but it just won't work for me and I am going round in circles so It would be greatly appreciated if someone could give me some guidance on the issue.
For Each TextListBox(i).ButtonGroup In Me.Controls
If (TypeOf TextListBox(i).ButtonGroup Is CommandButton) Then
TextListBox(i).ButtonGroup.Visible = False
End If
Next
You haven't given a lot of information but you can't loop that way - you need to loop through the array:
For i = Lbound(TextListBox) to UBound(TextListBox)
If TypeOf TextListBox(i).ButtonGroup Is MSForms.CommandButton Then
TextListBox(i).ButtonGroup.Visible = False
End If
Next

Control Caption Text is displayed smaller

I'm working on a Userform in Excel that has to be dynamically generated each time. It can list many (100+) lines which are all exactly the same in format. These are generated by the following code snippet.
' ctextbox
Set ctl = .Controls.Add("Forms.Textbox.1")
With ctl
.Top = 12 + linetop
.Left = 464.9
.Width = 140
.Height = 18
.Name = FieldName & "_ctextbox"
End With
' cshow
Set ctl = .Controls.Add("Forms.CommandButton.1")
With ctl
.Top = 13.1 + linetop
.Left = 611.35
.Width = 41.95
.Height = 18
.Name = FieldName & "_cshow"
.Caption = "Show All"
End With
' confirm
Set ctl = .Controls.Add("Forms.Checkbox.1")
With ctl
.Top = 13.5 + linetop
.Left = 659
.Width = 44.95
.Height = 17.25
.Name = FieldName & "_confirm"
.Caption = "Confirm"
End With
It would fine except for a random occurrence where the Confirm checkbox appears smaller than the rest. The screenshot below shows what I mean.
Has anyone experienced this issue before?
I would recommend using repainting the Userform after you have added the controls dynamically.
The Repaint method completes any pending screen updates for a specified form. When performed on a form, the Repaint method also completes any pending recalculations of the form's controls.
This method is useful if the contents or appearance of an object changes and you don't want to wait until the system automatically repaints the area. Me.Repaint simply updates the display by redrawing the form
I had the same issue in that my repaint did not work. I solved this by setting the CheckBox AutoSize property to True and I have no problems anymore.

There is insufficient memory available to complete this operation

I'm running into an unusual problem. I have an application with a multipage that contains about 10 pages and every page contains another multipage with 3-5 pages. The problem was that the app was too "heavy" and I wanted to break it into multiple forms (a form for every page).
In the initial app the form had as I said about 10 pages, with another 3-5 pages on every one of them and on every page there were about 3-20 comboboxes, 4-40 textboxes. All of them were loaded at initialization by executing a piece of code.
Now... I copied the piece of code for every page and added it in the initializations of the form that replaced it.
The code is something like this:
Private Sub UserForm_Initialize()
Dim i As Integer
Dim ws1 As Worksheet
Dim pagini As range
Set ws1 = Worksheets("Config")
Dim cControl As Control
Set cControl = Me.Controls.Add("Forms.Multipage.1", "oly", True)
With cControl
.Width = 650
.Height = 380
.Top = 0
.Left = 0
End With
Me.Controls("oly").Pages.Remove (Page1)
Me.Controls("oly").Pages.Remove (Page2)
For Each pagini In ws1.range("pagoly")
Me.Controls("oly").Pages.Add (pagini)
Next pagini
i = 0
Do While i < 5
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "iooly" & i, True)
With cControl
.Caption = "IO"
.Width = 210
.Height = 340
.Top = 2
.Left = 5
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "niooly" & i, True)
With cControl
.Caption = "nIO"
.Width = 210
.Height = 340
.Top = 2
.Left = 220
End With
Set cControl = Me!oly.Pages(i).Add("Forms.Frame.1", "descriere" & i, True)
With cControl
.Caption = "Descriere"
.Width = 210
.Height = 340
.Top = 2
.Left = 435
End With
Loop
End Sub
So far it just adds the frames on every of the 5 pages of this form. The problem is that I get the "There is insufficient memory available to complete this operation" when I want to run it and I really don't know why. Yet on the previous version which loaded 50 times more stuff there was no problem. Do you have any idea where's the problem because I really don't understand it.
You have
Do While i < 5
'stuff
Loop
and I don't see where i changes value so that the program will exit the loop. Am I missing something?