본문 바로가기

VBA (EXCEL 매크로)

VBA 학습 리스트

728x90

Sub 순차()
    For i = 1 To 10
        Cells(1, i).Value = i
    Next i
End Sub
Sub 짝수셀에짝수()
'
    For i = 2 To 20
        If (i Mod 2) = 0 Then
            Cells(i, 1).Value = i
        End If
    Next i
End Sub
Sub 하이프링크()
'
' 하이프링크
'
'
    Cells(1, 2).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "09_02.%20도면배포서\ME1%20CCB%20도면배포서%2023-330-230711-230811.pdf", TextToDisplay _
        :="09_02. 도면배포서\ME1 CCB 도면배포서 23-330-230711-230811.pdf"
End Sub
Sub filelist()
'
' file list
'
Dim dirPath As String
Dim fileName As String
Dim i As Integer

    Cells(1, 5).Select
    dirPath = "E:\09_02. 도면배포서\"
    fileName = Dir(dirPath & "*.*")
    
    Do While fileName <> ""
        i = i + 1
        Cells(i, 5).Value = fileName
        fileName = Dir()
    Loop
    
'
End Sub

Sub 그림추가()
'
' 그림 추가
'
    Cells(2, 4).Select
    ActiveSheet.Pictures.Insert("E:\사진자료\KakaoTalk_20230714_094246908.jpg"). _
        Select
    Application.Left = 1593.25
    Application.Top = 112
    Selection.ShapeRange.Height = 141.7322834646
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Width = 141.7322834646
    Application.CommandBars("Format Object").Visible = False
End Sub

Sub 셀병합()
' 셀병합

    Range(Cells(2, 12), Cells(6, 13)).Select
    Selection.Merge

End Sub

Sub 셀크기조정()
' 셀크기 조정

    Cells(2, 4).Select
    Cells(2, 4).ColumnWidth = 24
    Cells(2, 4).RowHeight = 70
End Sub

Sub 그림셀맞춤()
' 셀맞춰그림넣기

    With ActiveSheet.Pictures.Insert("C:\Users\영업팀230707\Pictures\돈걱정.jpg").ShapeRange
        .LockAspectRatio = msoFalse
        .Height = Selection.Height
        .Width = Selection.Width
        .Left = Selection.Left
        .Top = Selection.Top
    End With
End Sub

Sub 시트추가_셀값으로이름변경()
' 시트추가_셀값으로이름변

For i = 1 To 10
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Select
    ActiveSheet.Name = Sheets(1).Cells(i, 1).Value
Next i
End Sub

Sub 시트삭제()
' 시트 삭제

Dim i As Integer
For i = 1 To 3
    Worksheets(2).Delete
Next i
End Sub

728x90