Excel freezes after pasting text to a userform textbox - vba

I have a vba userform text box with,
ControlSource = An Excel Cell
EnterKeyBehavior = True
MultiLine = True
MaxLength = 500
When I copy paste a text in the box such as a random text below:
Where does it come from?
Contrary to popular belief, Lorem Ipsum is not simply random text. It has roots in a piece of classical Latin literature from 45 BC, making it over 2000 years old.
and step away for this text box (by clicking somewhere else such an another text box),
excel freezes (no response, cant open any excel file)
CPU usage for excel gets to ~50% (exceptionally high compared to normal use)
Do you know the reason for this freeze/behaviour?
Code behind the user form:
Private Sub CommandButton_PD_NP_Click()
If Me.Tb_PD_1.Value = "" Or Me.Tb_PD_2.Value = "" Then
MsgBox "Please specify your Business Area and Activity Name.", vbExclamation, "Error!"
Exit Sub
End If
Unload Me
Uf2_Security.Show
End Sub
Private Sub CommandButton_PD_PP_Click()
Unload Me
Uf1_Initiate.Show
End Sub
Private Sub UserForm_Initialize()
With Uf15_Project_Details
.Height = 357
.Left = 0
.StartUpPosition = 2
.Top = 0
.Width = 480
End With
End Sub

Related

Adjust the size of a chart in Word

I want to create a macro in Microsoft Word, that when I select a chart: allows me to activate the macro, and the height and width automatically change, to take the full width of the sheet, or take only half. For this I was using VBA with the following code:
Sub Resize()
With Selection
If .InlineShapes.Count > 0 Then
With .InlineShapes(1)
If .HasChart Then
With .Chart.ChartArea
.Width = 150
End With
End If
End With
End If
End With
Exit Sub
ErrorHandler:
MsgBox "Incorrect or missing data"
End Sub
The problem occurs when you try to access the property "Width", where you get an error at runtime of code 445 (Object doesn't support this action).

Creating Permanent Textbox on an Excel Userform

So I am creating a tool and user guide for my client. I am attempting to integrate the user guide into Excel in the form of a Userform. My first attempt was to insert these as images of the word document, however, if the user guide is ever updated that could mean a lot of work for anyone to update the userform as well. So I was looking to see if I could have a button for the user to click that would clear the userform and recreate it dynamically any time the User Guide is updated. My issue is that when I run my code the textboxes I create which contain the text from the user guide disappear after the userform is closed.
Do I have to have a set number of textboxes or can this be dynamic in the case that the user ever adds a new section to the user guide? Can I create textboxes that stay on the userform once it is closed?
My code is below:
For i = 1 To totPara
If wrdDoc.Paragraphs(i).Style = wrdDoc.Styles("Heading 1") Or wrdDoc.Paragraphs(i).Style = wrdDoc.Styles("Heading 2") Then
headerCtr = headerCtr + 1
If headerCtr = 2 Then
labelCtr = labelCtr + 1
Set tempTxt = Nothing
Set tempTxt = userGuide.Controls.Add("Forms.TextBox.1", "Test" & labelCtr, True)
With tempTxt
.Height = 276
.Width = 288
.Top = 54
.Left = 42
.MultiLine = True
End With
tempTxt.Text = wrdDoc.Paragraphs(i).Range.Text & Chr(13)
ElseIf headerCtr > 2 Then
Exit For
End If
ElseIf labelCtr <> 0 Then
tempTxt.Text = tempTxt.Text & wrdDoc.Paragraphs(i).Range.Text & Chr(13)
End If
Next i
For right now I set it to create a new textbox only when headerCtr is equal to 2 for testing but eventually I would like to create a new textbox for each of the 9 sections.
Thank you in advance for any help.
You have the option Hide the userform instead of Close the userform. When it is hidden the textboxes can still be accessed from the calling form.
Dim frm1 As frmMainInput
Set frm1 = New frmMainInput
frm1.tbProjectNumber.Value = iProject_Number
frm1.txtDocsInUse.Text = sDocsInUse
frm1.Show
If frm1.Proceed = False Then
GoTo Local_Exit
End If
iProject_Number = CInt(frm1.tbProjectNumber.Value)
Eventually call frm.close and set frm = Nothing
In the UserForm:
Private Sub cmdCancel_Click()
Proceed = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
Proceed = True
Me.Hide
End Sub
No clue about the refreshing images etc.c

Reading Userform Object Values

I created a Userform (manually in the VBA Projectbrowser). I have written VBA code, which fills this Userform with different Objects in runtime (Labels, Optionbuttons etc.). So far everything worked fine
The Userform is filled with data read from my Excel sheets and correctly displayed. However I'm not able to read the inputs from the objects on it (for example Optionbutton - TRUE or FALSE). These objects do not appear anywhere (except on the userform) so that I can link them and use them in another Module.
I guess they are only displayed and not really read into the memory or whatever (initialized !?).
There are two ways to go about it.
WAY 1
Declare your option button object as Public.
Module Code
Public theOpBut As Object
Sub Fill()
If theOpBut.Value = True Then
ActiveSheet.Cells(1, 5) = 1
Else
ActiveSheet.Cells(1, 5) = "NO"
End If
End Sub
Userform Code
Private Sub UserForm_Initialize()
Set theOpBut = UserForm1.Controls.Add("Forms.optionbutton.1", "OptionButton", True)
With theOpBut
.Caption = "Test Button"
'.GroupName = OpButGroupCounter
.Top = 10
.Left = 20
.Height = 16
.Width = 50
.Font.Size = 12
.Font.Name = "Ariel"
End With
End Sub
Private Sub CommandButton1_Click()
Call Fill
End Sub
WAY 2
Declare a Boolean Variable and create a click event of the Option button and then set the value of the Boolean Variable in that click event. To create the click event of the Option button at Run Time, see THIS EXAMPLE
You can then check the value of Boolean Variable in Sub Fill() and act accordingly.

Type 13 mismatch error in VBA excel

Dear friends I'm trying to display photos of the persons as per the name selected in a combo box.
I'm successful in doing that but my problem is that
while continuously choosing different names in combo box suddenly at times it displays ** error 13, type mismatch** and my combo box too disappearing. But after that making the visibility of Mypics(Name defined to the table of person names and pictures) "TRUE" its appearing again after compiling 2 to 3 times.
here is my code
Private Sub Worksheet_Calculate()
Dim Mypics As Picture
Me.Pictures.Visible = False
With Range("B8")
For Each Mypics In Me.Pictures
If (Mypics.Name = .Text) Then
Mypics.Visible = True
Mypics.Top = .Top
Mypics.Left = .Left
Exit For
End If
Next Mypics
End With
End Sub
The cell "B8" is where the name of the picture appears according to the selected person name in combo box with reference to the Index number.
Often, cleaning up your code can produce wonders. I sincerely suggest avoiding using With if you're just aiming to use it once, as in your original code. How about trying the following:
Private Sub Worksheet_Calculate()
Dim Mypics As Picture
Dim TargetName As String
TargetName = Range("B8").Text
Me.Pictures.Visible = False
For Each Mypics In Me.Pictures
If Mypics.Name = TargetName Then
With Mypics
.Visible = True
.Top = .Top
.Left = .Left
End With
Exit For
End If
Next Mypics
End Sub
Let us know if this works. Also, try to Dim everything you can properly Dim. Often, a type mismatch error is thrown due to a variable being declared wrongly at the beginning of a code.

How to expand the hidden rows in excel using vba?

I have a spreadsheet, which has 100 rows. Among these 100 rows, only 10 rows are required to be displayed at first, other 90 rows should be collapsed(hidden) at first. If user wants to read the whole 100 rows, he/she can click the button to expand the spreadsheet of 10 rows to 100 rows. How to implement this kind of function in VBA?
You could use a command button:
Private Sub CommandButton1_Click()
'// Label button "Show Rows"
With Me.CommandButton1
If .Caption = "Show Rows" Then
.Caption = "Hide Rows"
Rows("11:100").Hidden = False
Else
.Caption = "Show Rows"
Rows("11:100").Hidden = True
End If
End With
End Sub
Or a toggle button:
Private Sub ToggleButton1_Click()
'// Label Something Like "Show/Hide Rows"
Rows("11:100").Hidden = Not ToggleButton1.Value
End Sub