this the code i have done until now , it works with one cell value and one photo only and it does not respect the cell height and width .
i want to make it works with multiple cells and images with respecting cells height and width
i hope someone can help
`Sub Auto_Insert_Photo()
Application.ScreenUpdating = False
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next
Dim Asset As String, T As String
myDir = "D:\DOCUMENTATION\EQUIPMENT PHOTOS\AC BREAKERS\"
Asset = Range("A2")
T = ".png"
Range("C4").Value = EmployeeName
ActiveSheet.Shapes.AddPicture FileName:=myDir & Asset & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=190, Top:=10, Width:=120, Height:=120
Application.ScreenUpdating = True
End Sub`
Related
I have a macro to select slides, with required text, to move to a new presentation.
I have to extract 70-80 slides from a 500+ slides presentation. But I need to enter VB/Module to change the keywords/search text in the array. Is there a way I can move the text entered in the userform to the array (text)?
Userform to enter the keywords.
How do I link the text entered with the array list in the code?
Sub selct()
Dim pres1 As PowerPoint.Presentation, pres2 As PowerPoint.Presentation,
pp As Object
Set pp = GetObject(, "PowerPoint.Application")
Set pres1 = pp.ActivePresentation
Set pres2 = pp.Presentations.Add
Dim i As Long, n As Long
Dim TargetList
'~~> Array of terms to search for
TargetList = Array("Agenda", "Review", "third", "etc")
'~~> Loop through each slide
For Each sld In pres1.Slides
'~~> Loop through each shape
For Each shp In sld.Shapes
'~~> Check if it has text
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For i = 0 To UBound(TargetList)
'~~> Find the text
Set rngFound = txtRng.Find(TargetList(i))
'~~~> If found
Do While Not rngFound Is Nothing
'~~> Set the marker so that the next find starts from here
n = rngFound.Start + 1
'~~> Chnage attributes
With rngFound.Font
.Bold = msoFalse
sld.Copy
pres2.Slides.Paste
'~~> Find Next instance
Set rngFound = txtRng.Find(TargetList(i), n)
End With
Loop
Next
End If
Next
Next
End Sub
The form objects are accessible even when the form is not shown, like this: Suppose you have a form with name UF1 with a textbox named TBforKeyWord, then you can access the textbox value at UF1.TBforKeyWord, so you might
Redim Preserve TargetList(Ubound(TargetList) + 1)
TargetList(Ubound(TargetList) = UF1.TBforKeyWord
The logic is the same if you let the user enter multiple keywords but then you need to work a bit more on splitting (and parsing) the keywords.
EDIT
Dim text_array() As String
text_array = Split(SearchBox.Value, " ")
Dim iDimOld As Long
Dim iDimNew As Long
Dim i As Long
iDimOld = Ubound(TargetList)
iDimNew = iDimOld + Ubound(text_array) + 1
Redim Preserve TargetList(iDimNew)
' Loop through each keyword in array
For i = 0 To Ubound(text_array)
TargetList(iDimOld + i + 1) = text_array(i)
Next
I would like to fill a Combobox with a row (CAT, DOG, FISH, ...) in Excel
What I did so far is the following
Private Sub UserForm_Initialize()
Dim Axis As Variant
Axis = Rows(1)
ComboBox1.List = Axis
End Sub
Compiling works but I can only see the first Value (for example CAT).
And if I try the following code....
Private Sub UserForm_Initialize()
Dim Axis As Variant
Axis = Columns(1) '<< Columns instead of Rows
ComboBox1.List = Axis
End Sub
.... the Combobox contains the whole Column.
I tried many things but couldn't find a solution yet.
Therefore I'm asking you guys if anybody could help me please.
Thanks
If you have a row and want them displayed in a single list you have to transpose
ComboBox1.List = Application.Transpose(Sheet1.Range("A1:C1").Value)
You can also do
ComboBox1.List = Array("Cat", "Dog", "Fish")
To keep a row in a line you have to increase the column count of the combobox.
What works for me is:
Dim axis as Variant
Dim lstColumn As Long
'Find last Column
With ActiveSheet.UsedRange
lstColumn = .Columns(.Columns.Count).Column
End With
'Fill axis with all values from the first row
axis = Application.ActiveSheet.Range(Cells(1, 1), Cells(1, lstColumn))
'Write all values of axis in Combobox
ComboBox11.Column = axis
I prefer to use following code so that I could easily remove or add the listed item on the reference table.
Dim wS As Worksheet
Dim refTable As Range
Set wS = Sheet1
Set refTable = wS.Range("A1" , Cells(Rows.Count, "A").End(xlUp))
Combobox.List = refTable.Value
You could change the refTable range to change "A1" and "A".
Also it could be used for the row to change Rows.Count and xlUp.
I am running a sub where I need to count the number of checked checkboxes in a groupbox and do this for several groupboxes.
Edit: I forgot to mention I am using form controls and not ActiveX controls.
My first issue is creating an array of group boxes. I tried using
GB_Array = Activesheet.Shapes.Range(Array(Cells(x, y), Cells(z, y))) ' x,y,z defined elsewhere
I can make that work by manually adding, but it isn't ideal. My second issue is with this part:
Option Base 1
Dim cbox as Checkbox
Dim C_cbox as Integer
GB_Array = Array("Name1", "Name2") ' Manually adding groupboxes to the array
For i = 1 to Ubound(GB_Array, 1)
For Each cBox In Activesheet.Shapes.Range(GB_Array(1))
If cBox.Checked = True Then
C_cbox = C_cbox + 1
End If
Next cBox
Next i
Returns type mismatch error 13.
EDIT: Seems like I made the mistake of grouping the group box with the checkboxes, the answer works for "ugnrouped" groupboxes (so I can move the groupboxes without the checkboxes).
Is this what you are trying?
My assumptions: All controls are form controls.
I have commented the code so you should not have a problem understanding it. Still if you do have any queries then simply ask :)
Sub Sample()
Dim ws As Worksheet
Dim gbox As GroupBox
Dim Shp As Shape
Dim rngGBox As Range
Dim C_cbox As Integer
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Loop through group boxes
For Each gbox In .GroupBoxes
'~~> Get the range of the groupbox
Set rngGBox = .Range(gbox.TopLeftCell, gbox.BottomRightCell)
'~~> Loop through all shapes
For Each Shp In gbox.Parent.Shapes
If Shp.Type = msoFormControl Then
'~~> Check if the shape is within the groupbox range
If Not Intersect(Shp.TopLeftCell, rngGBox) Is Nothing Then
If Not Shp Is gbox Then
'~~> Check if it is a checkbox
If Shp.FormControlType = xlCheckBox Then
'~~> Check if it is checked
If Shp.ControlFormat.Value = xlOn Then
C_cbox = C_cbox + 1
End If
End If
End If
End If
End If
Next Shp
Next gbox
End With
End Sub
And if you want to work with specific group boxes then you can use this
Sub Sample()
Dim ws As Worksheet
Dim grpBxNames As String
Dim grpBxArray As Variant
Dim gbox As GroupBox
Dim Shp As Shape
Dim rngGBox As Range
Dim C_cbox As Integer
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Put the names separated by comma
'~~> we will create the array during runtime
grpBxNames = "Group Box 1,Group Box 6"
grpBxArray = Split(grpBxNames, ",")
With ws
'~~> Loop through array of group boxes
For i = 1 To UBound(grpBxArray)
'~~> Set you object
Set gbox = .GroupBoxes(grpBxArray(i))
'~~> Get the range of the groupbox
Set rngGBox = .Range(gbox.TopLeftCell, gbox.BottomRightCell)
'~~> Loop through all shapes
For Each Shp In gbox.Parent.Shapes
If Shp.Type = msoFormControl Then
'~~> Check if the shape is within the groupbox range
If Not Intersect(Shp.TopLeftCell, rngGBox) Is Nothing Then
If Not Shp Is gbox Then
'~~> Check if it is a checkbox
If Shp.FormControlType = xlCheckBox Then
'~~> Check if it is checked
If Shp.ControlFormat.Value = xlOn Then
C_cbox = C_cbox + 1
End If
End If
End If
End If
End If
Next Shp
Next
End With
End Sub
I don't believe you need an array of check boxes. Please look at the code below.
Sub ResetCheckBoxes()
Dim Ctrl As OLEObject
Dim n As Integer
For Each Ctrl In ActiveSheet.OLEObjects
If TypeName(Ctrl.Object) = "CheckBox" Then
Debug.Print Ctrl.Object.GroupName, Ctrl.Object.Value
Ctrl.Object.Value = True
End If
Next Ctrl
End Sub
The code loops through all ActiveX controls on the ActiveSheet and picks out CheckBoxes. It then prints the box's GroupName and Value properties before changing the Value. Run the code again to see the changed value.
The GroupName is the tab name by default. You can assign another value to it either manually, when you create the check box or using the above code. Once all check boxes within a particular group have the same GroupName you can add a further If condition to the above loop and pick out only those which belong to that particular group - and that fulfills your purpose of an array.
I'm new in excel VBA, can someone help me understand and tell me how can i print all sheet data to the userform textbox, instead of single column which this code is printing. I have data in the sheet6("Tables") till column AA 360
Dim arr As Variant
Dim myarr As String
Dim i As Long
myarr = Sheets("Tables").Range("A:AA").Value
For i = LBound(myarr, 1) To UBound(myarr, 1)
myarr = myarr & myarr(i, 1) & vbCrLf
Next i
TextBox1 = myarr
I think that using ListBox instead of TextBox would be much more useful for you. Add it to UserForm1 (it is name of your Userform if you haven't changed it) and add values:
With UserForm1.ListBox1
.ColumnCount = 27
.ColumnWidths = "50"
.RowSource = "'Tables'!A1:AA360"
End With
You can manipulate value in .ColumnWidths to adjust it for your data.
i have the following function that im using to populate a userform listbox with data from an array:
Function PopulateListboxWithArray(lstbox As MSForms.ListBox, var As Variant)
With lstbox
If Not IsEmpty(var) Then
.Clear
.list = Application.Transpose(var)
.ListIndex = -1
End If
End With
End Function
My listbox contains two columns with the following properties:
PROBLEM
The data in the array has an ID column and a lastname column. I dont want the user to see the ID column so ive set that column width to 0 in the form.
When i import data that has more than one row, the data shows up in the listbox as expected.
However, when the array only contains one row of data, the listbox shows up blank !
I have tried deleting the columnwidths in the image above and when i do so and reimport the one row of data, i get the ID and lastname stacked on top of one another. But ofcourse this is not the result i want.
I have even tried replacing .list = Application.Transpose(var) with .list = var to no avail.
What am i doing wrong here, or is there a better way to populate a listbox?
cheers
I have found the answer in this post:Adding item in listbox with multiple columns
I needed to use the .List property My function now looks like this:
Function PopulateListboxWithArray(lstbox As MSForms.ListBox, var As Variant)
With lstbox
If Not IsEmpty(var) Then
.Clear
If UBound(var, 2) > 0 Then
.list = Application.Transpose(var)
Else
.AddItem var(0, 0)
.list(.ListCount - 1, 1) = var(1, 0)
End If
End If
End With
End Function
edit to add more "background"
not so sure why you're using Application.Transpose()
With lstbox
If Not IsEmpty(var) Then
.Clear
If UBound(var, 1) = 1 Then
.AddItem
.List(0, 0) = var(1, 1)
.List(0, 1) = var(1, 2)
Else
' .List = Application.Transpose(var)
.List = var
End If
.ListIndex = -1
End If
End With
where I populated var in the following way:
Private Sub UserForm_Initialize()
Dim var As Variant
With Worksheets("LB") '<--| change "LB" to your actual sheet name
var = .Range("B1", .Cells(.rows.Count, "A").End(xlUp)).Value '<--| populate var with columns "A:B" cells values from row 1 down to column "A" last non empty row
End With
With Me.ListBox1
.ColumnCount = 2 '<--| set listbox columns count
.ColumnWidths = "0;144" '<--| set listbox columns width
End With
PopulateListboxWithArray Me.ListBox1, var
End Sub