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 Sub

2.Delete specific shape
Option 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



Thursday, December 5, 2019
Tag :

[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




Access ActiveX Controls by:
Worksheet("sheetname").ComponentName

Ex:
Sub main()
    Debug.Print ActiveSheet.TextBoxName.Value
    'or
    Debug.Print ActiveSheet.OLEObjects("TextBoxName").Object.Value
End Sub

For 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] Excel Form Control

 aaa

[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
2.1 ComandButton



Double click on button, source code of click event will be display as below:
Private Sub CommandButton_CANCEL_Click()
'    Unload Me
    Hide
End Sub

Private Sub CommandButton_OK_Click()
    'some code
    
    Hide
End Sub

2.2 Label
Label1 = "some string"

2.3 InputTextBox
TextBox1.Value = "some string"

2.4 ListBox
'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


2.5 ComboBox
'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


2.6 CheckBox, OptionButton(radio button)
ChekcBox and OptionButton are the same in set/get value
'set init 
CheckBox1.Value = False
        
'some code
'...

'get setting
If CheckBox1.Value = True Then
	'do something 1
Else
	'do something 2
End If


3. Progress dialog
Application.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

- Copyright © Lập trình hệ thống nhúng Linux . Powered by Luong Duy Ninh -