[017] 사진대지

[윤슬]

안녕하세요?

vba 배열을 이용한 사진대지 입니다.

사용법은 아주 간단합니다.

사진 삽입하기 버튼을 클릭하면 그림삽입 대화상자가 나타나고 해당 대화상자에서

사진을 선택하면 merge셀의 크기에 맞춰 사진이 자동입력됩니다.

물론 추후 사진을 보며 사진설명이나 일시만 입력하면 됩니다.

사진대지 초기화 버튼을 클릭하면 입력된 사진을 삭제해서 초기화 합니다.

이 자료는 KFC님이 주코드를 작성했고 제가 약간의 수정을 한 자료입니다.

KFC님께 감사의 말씀 전합니다.

코드는 아래와 같습니다.

Option Explicit

Private Sub CommandButton1_Click()

Dim jhrng() As Range, Trng As Range
Dim jhBool As Boolean, TBool As Boolean
Dim jhShp As Shape
Dim i As Integer, j As Integer

For Each Trng In ActiveSheet.UsedRange    '사진을 담을 범위를 배열에 저장
    If Trng.MergeCells And Trng.MergeArea.Rows.Count = 9 And Trng.Address = Trng.MergeArea.Cells(1).Address Then
        i = i + 1
        ReDim Preserve jhrng(1 To i)
        Set jhrng(i) = Trng.MergeArea
    End If
Next Trng

For j = 1 To UBound(jhrng)
    For Each jhShp In ActiveSheet.Shapes  '개체를 돌면서 해당 영역에 사진이 있는지 확인
        If Intersect(jhrng(j), Range(jhShp.TopLeftCell, jhShp.BottomRightCell)) Is Nothing Then
            TBool = True
        Else
            TBool = False
            Exit For
        End If
    Next jhShp
    If TBool Then  '모든 개체를 확인해서 해당영역에 사진이 없다면
        jhBool = Application.Dialogs(xlDialogInsertPicture).Show
        If jhBool Then
            With Selection
                .Left = jhrng(j).Left + 5
                .Top = jhrng(j).Top + 5
                .Width = jhrng(j).Width - 8
                .Height = jhrng(j).Height - 8
            End With
           
        Selection.ShapeRange.Height = 255#
        Selection.ShapeRange.Width = 340.5

        Else
            Exit Sub    '사진을 선택하지 않으면 나가기
        End If
    End If
   
Next j

Range("a1").Select

End Sub

Private Sub CommandButton2_Click()
    Dim shp As Shape
   
    If MsgBox("모든 그림개체가 사라집니다. 시행하시겠습니까?", vbQuestion + vbYesNo, "재확인") = vbYes Then
        For Each shp In ActiveSheet.Shapes
            If InStr(shp.Name, "Picture") > 0 Then
                shp.Delete
            End If
        Next
    End If
End Sub

자세한 내용은 첨부파일을 참고로...

그럼 또...!

===========================================================================================

첨부파일

090715_사진대지.xlsm

===========================================================================================

[외톨이곰]

자료유용하게 잘쓰겠읍니다. 양식을 조금변형하다안됨 부탁드릴께요

[바다로간 멧돼지]

사진을 붙이는것 까지는 됐는데 인쇄가 안되고 사진이 깜빡거리는것은 왜그래요? 아시는분 도와주세요.

[바다로간 멧돼지]

양식- 보안경고, 옵션 이콘텐츠사용-사진삽입하기-사진더블클릭-양식에 사진붙다-사진그림 아래 취소버튼 누름- 사진인쇄----의 순서대로 진행했는데 뭐가 잘못되었을까요?

[박수진]

알러뷰알러뷰 입니당...넘감사해용.
어케하면 이리 멋진작업을 알수있는건가요?>..
공부하고싶어요..

너무감사합니다......

[날쌘곰]

어떡해 공부해야 이렇게 됩니까ㅜㅜ 부럽습니다. 인터넷의 고마움과 여러가지로 업무에 충실할수 있게 해주신점 감사합니다

[이군악]

후~ 이렇게 좋은 게 있는 걸 여태 몰랐네요.