| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
1. 엑셀 버전(95,97,2000,2002):
2. 윈도우즈의 버전(win95,win98,winME,winNT,win2000,winXP):
3. CPU (486,PentiumI/II/III/IV...):
4. RAM (32,64,128,256,512MB,1G...):
* 아래줄에 질문을 작성하세요 >>
쫄따구님이 만든건데 전 만들어진 라벨에 외각선을 만들고 싶은데
어케하면 되는지여....
Sub DmLabel()
' 오피스 배움과 나눔터 ☞ OFFICETutor.COM
Dim LbSht As Worksheet '라벨시트
Dim AddSht As Worksheet '주소록 시트
Dim TempS As Worksheet '임시 시트
Dim AddRng As Range '주소록의 사용 범위
Dim LbRng As Range '라벨의 시용 범위
Dim intA As Integer
Dim intB As Integer
Dim ClsOk As Boolean '라벨 시트 존재유무
For Each TempS In Worksheets
If TempS.Name = "라벨" Then '라벨 시트청소하기
TempS.Cells.Clear
Set LbSht = Worksheets("라벨")
Set LbRng = LbSht.[A1]
ClsOk = True
End If
Next TempS
If ClsOk = False Then '라벨 시트가 없으면 새로 만들기
Set LbSht = Worksheets.Add
LbSht.Name = "라벨"
Set LbRng = LbSht.[A1]
ClsOk = True
End If
Set AddSht = Worksheets("주소록")
Set AddRng = AddSht.[A2]
intA = AddRng.CurrentRegion.Rows.Count - 1 '반복할 횟수
Application.ScreenUpdating = False '갱신화면 감추기
For intB = 1 To intA
With LbRng
.Cells(1, 1) = AddRng.Cells(intB, 3) '우편번호
.Cells(2, 1) = AddRng.Cells(intB, 4) '주소
.Cells(3, 1) = AddRng.Cells(intB, 2) '회사명
.Cells(4, 1) = AddRng.Cells(intB, 1) & " 귀하" '성명
End With
If intB Mod 2 = 1 Then '홀수일때
Set LbRng = LbRng.Offset(0, 2) '그 줄 2칸 옆
Else '짝수일때
Set LbRng = LbRng.Offset(6, -2) '6칸 아래 왼쪽으로 2칸 이동
End If
Next intB
LbSht.UsedRange.Columns.AutoFit
LbSht.Activate
Application.ScreenUpdating = True
MsgBox "모두 " & intA & " 개의 라벨 만들었읍니다." & vbCr & _
"제대로 제작되었는지 확인해 보시고 " & vbCr & _
"인쇄하시려면 별도의 인쇄과정을 거치기 바랍니다..", , "OFFICE Tutor.COM"
End Sub |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
