2021. 9. 1. 09:46

[Excel-VBA] URL에 해당하는 이미지 자동으로 읽어오는 함수

어디선가 줒어온 소스;;;

urlCol 이랑 대상 컬럼, 시작Row, 대상 컬럼 정도만 맞추고 한번 슥 돌려주면 알아서 읽어옴

' 귀찮아서 인터넷에서 긁어옴
Sub getPictureFromURL()

Dim URL As String '이미지 URL 처리용 변수
Dim r As Long '작업중인 행
Dim urlCol As Integer ' URL이 들어있는 컬럼 번호
Dim targetCol As Integer ' 그림을 넣은 target 컬럼 번호

urlCol = 3
targetCol = 4

' 처음 1행은 헤더가 있기 때문에 2번째 row부터 시작
r = 2
Do
    URL = Cells(r, urlCol).Value  '각 셀의 값을 URL에 변수에 넣음
    On Error Resume Next '에러 발생해도 다음코드 진행
    ActiveSheet.Pictures.Insert(URL).Select 'URL 주소에 있는 각 그림을 삽입함
    
    If Err <> 0 Then '만약 무언가 오류가 발견되면, 그냥 무시하고 다음 항목으로 넘어간다
        Err.Clear 
        On Error GoTo 0
        GoTo errHandler
    End If
    
    With Selection '선택된 그림에서 작업
        .ShapeRange.LockAspectRatio = msoTrue '가로세로 비율고정(false면 해제)
        .Left = Cells(r, targetCol).Left + 2  '사진 왼쪽위치
        .Top = Cells(r, targetCol).Top + 2  '사진 윗쪽 위치
        .Height = Cells(r, targetCol).Height - 4  '사진 높이
        .Width = Cells(r, targetCol).Width - 4  '사진 너비
    End With
    
errHandler:
    
    r = r + 1 ' 다음행 데이터를 확인
Loop Until Cells(r, urlCol) = vbNullString
' URL 값이 공백을 만나면 종료
End Sub
2018. 4. 10. 18:25

VBA를 이용하여 엑셀의 선택 셀에 대한 대소문자 변경

MS 사이트에 있는 코드 긁어와서 한글 설명만 붙임


Sub ToggleCaseMacro(),

    Dim CaseRange As Range,

    Dim CalcMode As Long,

    Dim cell As Range,

,

    On Error Resume Next,

    ' 선택한 영역(셀이 하나 이상일 수 있음!)에 Text셀이 존재하는지 여부를 검사하는 함수,

    ' 선택영역과 선택영역의 Text셀이 중복되면 해당 영역을 반환. 없으면 Nothing 처리,

    Set CaseRange = Intersect(Selection, _,

        Selection.Cells.SpecialCells(xlCellTypeConstants, xlTextValues)),

    ,

    ' 일단 Error 무시,

    On Error GoTo 0,

    If CaseRange Is Nothing Then Exit Sub,

,

    ' 화면 갱신을 막아줌,

    With Application,

        CalcMode = .Calculation,

        .Calculation = xlCalculationManual,

        .ScreenUpdating = False,

        .EnableEvents = False,

    End With,

,

    ,

    ' 셀이 하나 이상일 수 있으니 모든 셀에 대해서 대문자면 소문자로, 소문자면 적절하게 변경하고 그 외의 경우는 대문자 처리함,

    For Each cell In CaseRange.Cells,

        Select Case cell.Value,

        Case UCase(cell.Value): cell.Value = LCase(cell.Value),

        Case LCase(cell.Value): cell.Value = StrConv(cell.Value, vbProperCase),

        Case Else: cell.Value = UCase(cell.Value),

        End Select,

    Next cell,

,

    ,

    ' 화면 갱신을 다시 진행,

    ' 이렇게 해야 화면에 변화하는게 안보이고 한번에 변경된거 같으면서 속도도 빠름,

    ' 의외로 새로 그리기 속도가 꽤 느리기 때문에 위의 갱신 막는것과 함께 같이 항상 써줘야 함,

    With Application,

        .ScreenUpdating = True,

        .EnableEvents = True,

        .Calculation = CalcMode,

    End With,

End Sub