So I have a multipage where I want the same button to show on both pages. I could place it outside but the border from the multipage is so ugly so I tried to place everything on the pages. Unfortunately you can't name the items (such as the combobox) with the same name. Is there a workaround to remove the borders and just show the page names or have the same name on the item on two pages?
Had some fun with this goal.
Consider this UserForm in Editor with TabStrip, 2 frames and some other controls.
Frames are named from Frame0, Frame1, etc.
Assuming the Frame0 is the location reference and first to display when UserForm is displayed, code below will be what you want.
Code:
Option Explicit
Private Sub TabStrip1_Change()
Dim i As Long, lActiveTabIndex As Long
lActiveTabIndex = Me.TabStrip1.Value
For i = 0 To Me.TabStrip1.Tabs.Count - 1
Me.Controls("Frame" & i).Visible = (i = lActiveTabIndex)
Next i
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
With Me
.Height = 288 ' Adjust to your desired height
' Align all FrameX top/left to same as Frame0, delete Caption and SpecialEffect
For i = 0 To Me.TabStrip1.Tabs.Count - 1
With Me.Controls("Frame" & i)
.Top = Me.Frame0.Top
.Left = Me.Frame0.Left
.Caption = ""
.SpecialEffect = fmSpecialEffectFlat
End With
Next i
End With
' Ensure frame for first tab is displayed
TabStrip1_Change
End Sub
Userform first load (didn't save screenshot, neither the workbook, sorry).
Next tab clicked:
Related
I have a macro that inserts Image controls on a form.
When these controls are clicked the user is asked to select an image file using the GetOpenFileName dialog box. The selected image is loaded into the control and the file path is added to column B on Sheet2.
When the Image control is clicked again the selected image is loaded to an Image control on a second form and displayed.
How do I add or attach the required code to each image control so the Click events will work?
The code I have so far is below:
Sub macroA1()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Set miesto = Sheets("Sheet2").Range("B2")
strfilename = Sheets("Sheet2").Range("B2").Value
If strfilename = "" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
ElseIf strfilename = "False" Then
strfilename = Application.GetOpenFilename(filefilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select a File", MultiSelect:=False)
Sheets("Sheet2").Range("B2").Value = strfilename
Else
Sheets("Sheet2").Range("B2").Value = strfilename
End If
On Error Resume Next
UserForm1.Image1.Picture = LoadPicture(strfilename)
If strfilename = "False" Then
MsgBox "File Not Selected!"
Exit Sub
Else
End If
UserForm1.Image1.PictureSizeMode = fmPictureSizeModeStretch
UserForm1.Show
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
Each Image control on your userform will need a click event. This single event is stored within a class module and attached to each Image control on the form.
Insert a class module, name it clsLoadImage and add the code below to it.
Public WithEvents Img As MSForms.Image 'Place at very top of module (after Option Explicit though).
Private Sub Img_Click()
Dim FullPath As String
With Img
'Only load the picture if the control is empty.
If .Picture Is Nothing Then
'Get the file path for the image.
FullPath = Application.GetOpenFilename
If Len(Dir(FullPath)) = 0 Then
MsgBox "No file find.", vbOKOnly + vbCritical
Else
.Tag = FullPath 'The Tag property can store extra info such as a text string.
'Store the path in last row of Sheet2 column B.
ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1) = FullPath
.Picture = LoadPicture(FullPath)
.PictureSizeMode = fmPictureSizeModeStretch
.Parent.Repaint
End If
Else
'If the image control isn't empty load the image
'into UserForm2 using the file path stored in
'the Tag property.
Load UserForm2
With UserForm2
With .Image1
.Picture = LoadPicture(Img.Tag)
.PictureSizeMode = fmPictureSizeModeStretch
.Parent.Repaint
End With
.Show
End With
End If
End With
End Sub
Next add a UserForm to the project. In the sample code I have left it named as UserForm1. Make the Height at at least 340 and fairly wide.
Add a CommandButton near the top and an Image control near the bottom (I put the Top at 218 for the image control).
These controls probably won't be included in your final solution but give different options depending on your requirements.
Add the below code to UserForm1.
This code will fire when you open the form.
The top part of the code will attach the Click event to any existing Image controls - such as the one that's placed near the bottom.
The bottom part of the code will create an Image control for each file path listed in Sheet2 column B and attach the Click event to it.
Note: Top is set as 134 placing them in the middle area of the form.
Public ImageControls As New Collection 'Place at very top of module (after Option Explicit though).
'Could execute when the form opens.
'''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Initialize()
'Relies on image controls added at design time.
'Attaches the click event to each image control.
Dim Ctrl As Control
Set ImageControls = New Collection
Dim ImgEvent As clsLoadImage
For Each Ctrl In Me.Controls
If TypeName(Ctrl) = "Image" Then
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = Ctrl
ImageControls.Add ImgEvent
End If
Next Ctrl
''''''''''''''''''''''''''''''''''''''''''''
'Creates an image control for each file path
'in Sheet2 column B, loads the picture,
'stores the path in the tag property,
'attaches the click event.
Dim x As Long
Dim tmpCtrl As Control
For x = 2 To ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
'Add the control, name it and position it.
Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "AddedInLoop_Image_" & x)
With tmpCtrl
.Left = .Width * (x - 2)
.Top = 134
.Picture = LoadPicture(ThisWorkbook.Worksheets("Sheet2").Cells(x, 2))
.PictureSizeMode = fmPictureSizeModeStretch
.Tag = ThisWorkbook.Worksheets("Sheet2").Cells(x, 2)
End With
'Attach the Click event to the control.
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = tmpCtrl
ImageControls.Add ImgEvent
Next x
Me.Repaint
End Sub
Add this code to UserForm1 as well to deal with the CommandButton that you added.
This will add an Image control each time you press the button.
Note - Top is set at 40 so they'll appear near the top of the form.
'Creates an image control and attaches
'a Click event to the control.
Private Sub CommandButton1_Click()
Dim CtrlCount As Long
Dim Ctrl As Control
Dim tmpCtrl As Control
Dim ImgEvent As clsLoadImage
'Count the Image controls so each
'new control has a unique name.
CtrlCount = 1
For Each Ctrl In Me.Controls
'NB: The InStr command is only needed so the controls
' added in the Initalise event aren't counted.
If TypeName(Ctrl) = "Image" And InStr(Ctrl.Name, "BtnClck_Image_") > 0 Then
CtrlCount = CtrlCount + 1
End If
Next Ctrl
'Add the control, name it and position it.
Set tmpCtrl = Me.Controls.Add("Forms.Image.1", "BtnClck_Image_" & CtrlCount)
With tmpCtrl
.Left = .Width * (CtrlCount - 1)
.Top = 40
End With
'Attach the Click event to the control.
Set ImgEvent = New clsLoadImage
Set ImgEvent.Img = tmpCtrl
ImageControls.Add ImgEvent
End Sub
Finally, add a second UserForm and add a single Image control named Image1 filling the form. I have left the form named as UserForm2.
To use:
Open UserForm1.
An Image control will be created for each full file path & name listed in column B of Sheet2. It will display the picture from the file path.
Pressing the button will create a blank Image control.
Clicking a blank Image control will open a dialog box asking you to select a file. The selected file will be loaded into the control and the file path added to column B on Sheet2.
Clicking an Image control that contains a picture will open UserForm2 with the image loaded into the Image control on that form.
I need to create ComboBox's and then AddItems to each ComboBox. This will all be done to a userform. I need to do this entirely within the VBA code, this is because each time the userform is opened new information will be shown.
this is what I have so far:
Private Sub UserForm_Initialize()
for i = 1 to size
Set CmbBX = Me.Controls.Add("Forms.ComboBox.1")
CmbBX.Top = ((90 * i) - 18) + 12 + 20
CmbBX.Left = 30
CmbBX.Text = "Please select an item from the drop down"
CmbBX.TextAlign = fmTextAlignCenter
CmbBX.Width = 324
CmbBX.Visible = False
CmbBX.Name = "ComBox2" & i
Next
end sub
the problem is, once each ComboBox is created its like its name isnt there. I cannot referance the combobox. this is what I have tried:
ComBox21.AddItems "Test1"
ComBox22.AddItems "Test2"
And it errors out. When I look at the UserForms function bar at the top of the screen (where I would usually select ComBox22_Change() for example), It shows that no ComboBoxes even exist!
Any Ideas on how to dynamically create and additems to comboboxes?
Thank you in advance
Here an sample of the code.
You need still to change it for you needs but this will be easy.
I have created a simple userform and one button to do test and it works fast.
To imput the comboboxes replace ".additem" with a loop to load each of them.
How to do that -- search in google
how to Populate a combobox with vba
You cannot refferance any controls on userform if they dont exist.
You need to search for them after creation and then modify them.
Example below with button code.
I think this should bring you to an idea how to manage this.
Option Explicit
Private Sub CommandButton1_Click()
Dim refControl As Control, frm As UserForm
Dim x
Set frm = Me
With Me
For Each x In Me.Controls
If TypeName(x) = "ComboBox" Then
Select Case x.Name
Case "cmbDemo3"
MsgBox "works!"
'here you can put your code
End Select
MsgBox x.Name
End If
Next x
End With
End Sub
Private Sub UserForm_Initialize()
Dim combobox_Control As Control
Dim i
For i = 0 To 5
Set combobox_Control = Controls.Add("forms.combobox.1")
With combobox_Control
.Name = "cmbDemo" & i
.Height = 20
.Width = 50
.Left = 10
.Top = 10 * i * 2
.AddItem "hihi" 'here you can add your input code
End With
Next i
End Sub
I have selected a Sentence.
1) The sentence can vary.
2) I have split each word of the sentence.
The code below creates a list of Word array from Selection.
Sub Seperate_Words()
Dim WrdArray() As String
WrdArray() = Split(Selection)
For i = LBound(WrdArray) To UBound(WrdArray)
strg = strg & vbNewLine & WrdArray(i)
Next i
MsgBox strg
End Sub
Now I want to add a Search button in front of each word.
In every situation, the length of a sentence would change and Userforms are Pre-specified that's why I can't use them.
Following Image shows how output should be
Now problem I am facing is adding a scroll bar in frame which dynamically changes if needed.
I have found a very interesting solution to this:
Create a UserForm (I have named mine "frmSearchForm")
Create a Frame on it (mine is "framTest")
Create a Classmodule and name it "clsUserFormEvents"
Add this Code to it:
Public WithEvents mButtonGroup As msforms.CommandButton
Private Sub mButtonGroup_Click()
'This is where you add your routine to do something when the button is pressed
MsgBox mButtonGroup.Caption & " has been pressed" 'Just Example Code
End Sub
Then in the ThisDocument Module, add this code:
Dim mcolEvents As New Collection
Sub createButtonsOnForm()
Dim Cmd As msforms.CommandButton
'create instance of class
Dim cBtnEvents As clsUserFormEvents
'array for selection
Dim wordArr() As String
'get selection into array
wordArr = Split(Selection, " ")
Dim i As Integer
'counter for the top position of buttons
Dim topcounter As Integer
topcounter = 10
'loop through array
For i = LBound(wordArr) To UBound(wordArr) Step 1
'create button
Set Cmd = frmSearchForm.framTest.Controls.Add("Forms.CommandButton.1", "Test")
'Adjust properties of it
With Cmd
.Caption = wordArr(i)
.Left = 100
.Top = topcounter
.Width = 50
.Height = 20
End With
'Instantiate Class
Set cBtnEvents = New clsUserFormEvents
'Add cmd to event in class
Set cBtnEvents.mButtonGroup = Cmd
'Add buttonevent to collection so it won't get deleted in next iteration of the loop
mcolEvents.Add cBtnEvents
'increase the top position
topcounter = topcounter + 25
Next i
'show userform
frmSearchForm.Show
End Sub
Then if you run this sub, the selection gets splitted into the array, a button for every element is created(selection part as caption) and if you press the button, the method inside the class gets called, where you can use the mButtonGroup.Caption propery to get the value of button.
Example:
I have selected the Words "Test1" and "Test2", now when I run the Sub, the Form opens with 2 Buttons(Test1 and Test2):
I am working in Excel 2010 on a large project. Part of it checks for balanced amounts in several different files and if any of them are out of balance, a form pops up with a list of clickable links to the files in question and the expected values. Up until recently, this has been working fine, but this morning I see that the Activate procedure isn't being called when I Show the form. If I click elsewhere and then click on the form again, the Activate procedure runs as it should. It just doesn't run the first time. I even tried stepping through the code and it's not called at all.
As you can see, I didn't change the name of the default "UserForm_Activate". I will say that I have added a lot of code to the project since the last time this functionality worked, but none of that code relates to this form or the procedure that calls it. (That being said, I still plan on looking for a connection there.)
The form is set up to be non-modal. I also have another form that I use as a user interface that is also non-modal and therefore stays visible when this form pops up. The OOBItems object in the code is a Dictionary object with the expected value as the data and the file paths as the keys. LabelLink is a class that makes the links clickable.
Option Explicit
Private LinkLabel() As LabelLink
'***********************************************************************
'Name: UserForm_Activate
'Description: Adds links as clickable labels to form when it is shown.
'
'Revision History:
'Date Author Changes made
'***********************************************************************
Private Sub UserForm_Activate()
Const LABELHEIGHT As Integer = 10
Const LABELSTARTTOP As Integer = 40
Const LABELWIDTH As Integer = 428
Const LABELLEFT As Integer = 6
Const MCSLABEL As String = "Forms.Label.1"
Const BLUE As Long = 16711680 'RGB(0, 0, 255)
Const PURPLE As Long = 16711935 'RGB(255, 0, 255)
Dim Links() As String
Dim LinkStart As Integer, LinkEnd As Integer
Dim LinkCount As Integer, LinkNum As Integer
'split the tag back into links
Links() = Split(Me.Tag, "||")
LinkStart = LBound(Links)
LinkEnd = UBound(Links)
LinkCount = LinkEnd - LinkStart + 1
ReDim LinkLabel(LinkStart To LinkEnd)
'loop through links to add them as labels
For LinkNum = LinkStart To LinkEnd
'create new instance of the LabelLink class
Set LinkLabel(LinkNum) = New LabelLink
'add the label to the form
Set LinkLabel(LinkNum).mObjLbl = Me.Controls.Add(MCSLABEL)
'format the label
With LinkLabel(LinkNum).mObjLbl
.Caption = Links(LinkNum)
.Height = LABELHEIGHT
.Left = LABELLEFT
.Width = LABELWIDTH
.Top = .Height * LinkNum + LABELSTARTTOP
.Font.Underline = True
.Font.Size = 8
'trying to fix the issue of the clicked link text going back to
'blue if you click on the main form then click back to this form
If .ForeColor = PURPLE Then
.ForeColor = PURPLE
Else
.ForeColor = BLUE
End If
End With
Next LinkNum
'refresh form
Me.Repaint
End Sub
'***********************************************************************
'Name: DisplayOOBLinks
'Description: Takes an array of links and opens the form to show them.
'
'Revision History:
'Date Author Changes made
'***********************************************************************
Public Sub DisplayOOBLinks(OOBItems As Object)
Const FORMBASEHEIGHT As Integer = 72
Const LABELHEIGHT As Integer = 12
Dim LinkCount As Integer
Dim TotalsText As String
'get count of OOB items
LinkCount = OOBItems.Count
'resize userform for the number of links to show
Me.Height = LinkCount * LABELHEIGHT + FORMBASEHEIGHT
'resize the expected totals textbox for the number of OOB items
Me.Controls("ExpectedTotals").Height = (LinkCount + 1) * LABELHEIGHT
'add OOB values to expected totals textbox text
Me.Controls("ExpectedTotals").text = "Expected totals:" & vbLf & Join(OOBItems.Items, vbLf)
'preload the form so that the tag can be set
Load Me
'join the links into one string to assign to the tag since forms don't take
'any parameters
Me.Tag = Join(OOBItems.Keys, "||")
'show the form
Me.Show
End Sub
This is the entirety of the code module for the form in question.
Can anyone see why the Me.Show line would show my form, but not run the Activate procedure? I guess I could call it specifically after I show the form but I'd rather not use a workaround when I shouldn't have to.
Well, since no one (including me) could come up with anything better, I'll share my workaround and give it another few days before I close the question.
After I show the form, I call the activate procedure manually: UserForm_Activate. It works, but I'd still like to know why it isn't triggering automatically.
(disclaimer: i'm not a VBA programmer by occupation)
Attached to buttons in the Ribbon I have code to toggle the company logo in a Word Document.
One button for the logo type A, a second button for logo type B and a third for no logo (logo is preprintend on paper)
First I remove the logo with removeLogo and then i add it the requested logo with setLogoAt.
The first button click is fine (e.g. for Logo Type A), a logo is added to the header of the document. When i click an other button (e.g for Logo Type B) Word crashes (probably on removing the current logo)
What is wrong with my code (or less probably: with Word?)
Sub setLogoAt(left As Integer, path As String)
Dim logoShape As Shape
Dim anchorLocation As Range
Dim headerShapes As Shapes
Set logoShape = ActiveDocument. 'linebreks for readability
.Sections(1)
.Headers(wdHeaderFooterPrimary)
.Shapes
.AddPicture(FileName:=path, LinkToFile:=False,
SaveWithDocument:=True, left:=0,
Top:=0, Width:=100, Height:=80)
logoShape.name = "CompanyLogo"
logoShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
logoShape.RelativeVerticalPosition = wdRelativeVerticalPositionPage
logoShape.Top = CentimetersToPoints(0.1)
logoShape.left = CentimetersToPoints(left)
End Sub
Sub removeLogo()
Dim headerShapes As Shapes
Set headerShapes = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
Dim shapeToDelete As Shape
If (headerShapes.Count > 0) Then
If Not IsNull(headerShapes("CompanyLogo")) Then
Set shapeToDelete = headerShapes("CompanyLogo")
End If
End If
If Not (shapeToDelete Is Nothing) Then
shapeToDelete.Delete
End If
End Sub
edit
I steped trough my code. All is fine until I reach the line shapteToDelete.Delete in removeLogo. Here Word crashes hard, even while debugging. I'm using Word 2007 (and that is a requirement)
edit2
I cleared all macros, all normals.dot, all autoloading templates, then created a new document with the two routines above and this test method:
Sub test()
setLogoAt 5, "C:\path\to\logo.jpg"
removeLogo
setLogoAt 6, "C:\path\to\logo.jpg"
End Sub
When I run test it crashes in removeLogo at shapeToDelete.Delete.
Edit 3
I 'solved' the problem by first making the headers/footers view the active view in Word, then deleting the Shape and then returning to normal view. Very strange. It works but as a programmer I'm not happy.
Another potential solution is to try and select the shape first and then delete the selection:
shapeToDelete.Select
Selection.Delete
You would probably want to switch off screen updating if this works, else you'll get flickering as Word moves around the document.
I've experienced this problem before and normally with an automation error: "The object invoked has disconnected from its clients". I haven't yet found a solution.
However a good workaround is to hide the shape rather than delete it.
So:
shapeToDelete.Visible = False
This works:
I only have 2 boxes to hide so this isn't generic
Private Sub btnPrint_Click()
Dim hdrShapes As Shapes
Dim S As Shape
Dim aTohide(2) As String
Dim iNdx, i As Integer
iNdx = 0
' Hide buttons and print
Set hdrShapes = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
' GET BUTTON NAMES (ACTUALLY TEXT BOXES
For Each S In hdrShapes
If S.Type = msoTextBox Then
aTohide(iNdx) = S.Name
iNdx = iNdx + 1
End If
Next
' now hide , use the arrays as the for each statement crashes
For i = 0 To 1
hdrShapes(aTohide(i)).Visible = msoFalse
Next
' print it
With ActiveDocument
.PrintOut
End With
' and unhide the buttons
For i = 0 To 1
hdrShapes(aTohide(i)).Visible = msoTrue
Next
Set hdrShapes = Nothing
End Sub