Showing posts with label VBA. Show all posts
[VBA] Delete Shapes (Form Controls / ActiveX Controls / Picture)
1.Delete all shapes
Sub Delete_All_Shapes()
'Delete all Objects except Comments
On Error Resume Next
ActiveSheet.DrawingObjects.Visible = True
ActiveSheet.DrawingObjects.Delete
On Error GoTo 0
End Sub2.Delete specific shapeOption Explicit
Private Const TYPE_FORM_CONTROL As Integer = 8 'Forms controls
Private Const TYPE_ACTIVEX_CONTROL As Integer = 12 'ActiveX control (control toolbox) or a linked or embedded OLE object.
Private Const TYPE_PICTURE As Integer = 13 'Picture
Sub Delete_specific_Shapes()
Dim myshape As Shape
For Each myshape In ActiveSheet.Shapes
Debug.Print "-----"
Debug.Print "myshape.Type/Name", myshape.Type, myshape.Name
Debug.Print "", myshape.TopLeftCell.Address, myshape.BottomRightCell.Address
If myshape.Type = TYPE_FORM_CONTROL Then
myshape.Delete
ElseIf myshape.Type = TYPE_ACTIVEX_CONTROL Then
' myshape.Delete
ElseIf myshape.Type = TYPE_PICTURE Then
' myshape.Delete
End If
' You can also use myshape.Visible = False
Next myshape
End Sub
[VBA] Insert ComboBox reference to list using name alias
1. Create new name alias
- Ctrl + F3 to open Name Manager
- Click "New"
- Input "Name" and select "Refers to"
- Click OK, close Name Manager
2. Insert ComboBox
- Click on cell where will be insert ComboBox
- From menu bar, select "Data / Data Validation"
- In "Settings" tab, select "List" to "Allow" field
- In "Source" field, input below content
="defined name alias in step1"
[VBA] Insert Picture
Option Explicit
Sub main()
Dim imagepath As String
Dim imagePos As Range
imagepath = "C:\Users\mypc\Pictures\myimg\commandbutton.JPG"
Set imagePos = Range("B2:D8")
Call InsertPictureInRange(imagepath, imagePos)
End Sub
' inserts a picture and resizes it to fit the TargetCells range
Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
Dim p As Object, t As Double, l As Double, w As Double, h As Double
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count).Left - .Left
h = .Offset(.Rows.Count, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Sub
[VBA] ActiveX Controls
1. Create and set/get value to control
Sub main()
Debug.Print ActiveSheet.TextBoxName.Value
'or
Debug.Print ActiveSheet.OLEObjects("TextBoxName").Object.Value
End SubFor how to set/get component value, reference to UserForm
2. Get type of ActiveX control
Sub getTypeControl()
Dim ws As Worksheet
Dim oleob As OLEObject
Set ws = ActiveSheet
For Each oleob In ws.OLEObjects
If TypeName(oleob.Object) = "TextBox" Then 'if type: TextBox
oleob.Object.Value = "hihi haha"
End If
Next
End Sub[VBA] UserForm
https://www.excel-easy.com/vba/userform.html
1. Begin / End
・UserForm1.Show
Display userform
・UserForm1.Hide
Do not display userform, form's data are remain
・Unload UserForm1
Destroy userform (userform do not display and all form'data also not exist)
Option Explicit
Sub main()
With UserForm1
'Display form dialog
.Show
'Some code
Debug.Print "Some code"
End With
'Destroy form
Unload UserForm1
End Sub
2.UserForm component
Private Sub CommandButton_CANCEL_Click()
' Unload Me
Hide
End Sub
Private Sub CommandButton_OK_Click()
'some code
Hide
End Sub
'Empty ListBox1
ListBox1.Clear
'Fill ListBox1
With ListBox1
.AddItem "San Francisco"
.AddItem "Oakland"
.AddItem "Richmond"
End With
'get ListBox1
Cells(emptyRow, 3).Value = ListBox1.Value'Empty ComboBox1
ComboBox1.Clear
'Fill ComboBox1
With ComboBox1
.AddItem "San Francisco"
.AddItem "Oakland"
.AddItem "Richmond"
End With
'set defaul item to 1st item (San Francisco)
Combobox1.ListIndex=0
'get ComboBox1 by value
Cells(emptyRow, 3).Value = ComboBox1.Value 'San Francisco because ListIndex=0
'get ComboBox1 by Index
Cells(emptyRow, 3).Value = ComboBox1.List(1) 'Oakland'set init
CheckBox1.Value = False
'some code
'...
'get setting
If CheckBox1.Value = True Then
'do something 1
Else
'do something 2
End IfApplication.ScreenUpdating = True
progressCounter = progressCounter + 1
UserForm1.Label_progress.Caption = "test msg"
UserForm1.Label_filename.Caption = "test msg"
Application.Wait (Now + TimeValue("0:00:01"))
DoEvents
Application.ScreenUpdating = False[VBA] On Error
VBA Runtime Errors:
・Referencing a non-existent workbook, worksheet, or other object
・Invalid data ex. referencing an Excel cell containing an error
・Attempting to divide by zero
VBA On Error Statement:
・On Error GoTo 0
IF error, program is stop, display default error dialog
・On Error Resume Next
IF error, do not display error dialog, continue run next line code
・On Error GoTo Label
IF error, goto user defined label
Option Explicit
Sub ErrorResumenext()
'IF error, do not display error dialog, continue run next line code
'It mean that [Some code] will be run continue although error occur
On Error Resume Next
ActiveSheet.Shapes("Start_Button").Delete
If Err.Number <> 0 Then
Debug.Print "Error"
Else
Debug.Print "No error"
End If
'Some code
Debug.Print "do something"
End Sub
Sub ErrorGoTo0()
On Error Resume Next
ActiveSheet.Shapes("Start_Button").Delete
'From here IF error, program is stop, display default error dialog
'It mean that [Some code] do not run if error occur
On Error GoTo 0
ActiveSheet.Shapes("Start_Button").Delete
'Some code
Debug.Print "do something"
End Sub
Sub ErrGoToEnd()
'IF error, goto label nextProc
On Error GoTo nextProc
ActiveSheet.Shapes("Start_Button").Delete
'Some Code 1
nextProc:
'Some Code 2
End Sub

