| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
1. 엑셀 버전(95,97,2000,2002):97
2. 윈도우즈의 버전(win95,win98,winME,winNT,win2000,winXP):2000
3. CPU (486,PentiumI/II/III/IV...):3
4. RAM (32,64,128,256,512MB,1G...): 128
* 아래줄에 질문을 작성하세요 >>
엘셀 쉬트 안에 여러 가지 도형이 있습니다.
그 도형 중 하나를 마우스로 클릭해서 선택한 후 '커짐' BUTTON을 누르면
도형이 점점 커지고, '작아짐' 보턴을 누르면 점점 작아지게 프로그램하고
싶은데요.. 어떻게 하나요?
==============[HANQ님 글에 대한 답변입니다]==============
파일을 첨부했습니다.
가능한지 궁금합니다...
그리고, 평소에 도움을 많이 받고 있습니다. 감사합니다.
==============[HANQ님 글에 대한 답변입니다]==============
안녕하세요? HANQ 님!
물론 가능하답니다.
첨부한 파일을 참고하세요
Option Explicit
Const Es As String = "MagicSheet & 엑사모"
Private Sub cmd1_Click()
dhConVert True '확대
End Sub
Private Sub cmd2_Click()
dhConVert False '축소
End Sub
Private Sub cmd3_Click()
Dim strQ As String
Dim strName As String
Dim i As Long '도형의 종류
Dim s As Shape
strQ = "생성하고 싶은 도형의 종류를 입력하십시오"
strQ = strQ & vbCr & "삼각형, 사각형, 오각형, 원형이 지원됩니다"
strQ = InputBox(strQ, Es, "사각형")
If Len(strQ) = 0 Then
Exit Sub
Else
Select Case strQ
Case "삼각형"
i = 81
Case "사각형"
i = 1
Case "오각형"
i = 12
Case "원형"
i = 9
Case Else
MsgBox strQ & "란 이름의 도형은 없거나 지원하지 않습니다", vbExclamation, Es
Exit Sub
End Select
End If
With ActiveCell '현재 활성셀을 기준으로 도형을 만든다
Set s = ActiveSheet.Shapes.AddShape(i, .Left, .Top, .Width, .Height * 4)
End With
Set s = Nothing
End Sub
Private Sub dhConVert(blnL As Boolean)
'blnL 축소 확대 여부
cmd1.TakeFocusOnClick = False
cmd2.TakeFocusOnClick = False
'명령단추의 TakeFocusOnClick 속성이 True인 경우 포커스가 명령 단추에 이동하므로
'어떤 개체를 선택했는지를 알 수 없게 됩니다. 이 속성을 False로 하십시오.
Dim s As Shape
Dim i As Integer
On Error GoTo e1
If TypeName(Selection) = "Range" Then '워크시트 범위를 선택하면
MsgBox "워크시트 범위 대신 도형을 선택하십시오!", vbExclamation, Es
Else
Set s = Shapes(Selection.Name)
i = IIf(blnL, 10, -10) '변경할 크기
With s
.Width = .Width + i
.Height = .Height + i
End With
End If
e1:
End Sub
그럼...행운이 있으시길...!
==============[황기성님 글에 대한 답변입니다]==============
안녕하세요?
도형 이름을 자동으로 붙이는 루틴을 아래와 같이 추가하세요
Private Sub cmd3_Click()
Dim strQ As String
Dim strName As String
Dim i As Long '도형의 종류
Dim s As Shape
strQ = "생성하고 싶은 도형의 종류를 입력하십시오"
strQ = strQ & vbCr & "삼각형, 사각형, 오각형, 원형이 지원됩니다"
strQ = InputBox(strQ, Es, "사각형")
If Len(strQ) = 0 Then
Exit Sub
Else
Select Case strQ
Case "삼각형"
i = 81
Case "사각형"
i = 1
Case "오각형"
i = 12
Case "원형"
i = 9
Case Else
MsgBox strQ & "란 이름의 도형은 없거나 지원하지 않습니다", vbExclamation, Es
Exit Sub
End Select
End If
With ActiveCell '현재 활성셀을 기준으로 도형을 만든다
Set s = ActiveSheet.Shapes.AddShape(i, .Left, .Top, .Width, .Height * 4)
End With
s.Name = dhGetShapeName '이름 붙이기
Set s = Nothing
End Sub
Private Function dhGetShapeName() As String
'SHAPE라는 이름을 찾기
Dim i As Integer
Dim j As Integer
Dim intTemp As Integer
Dim k As Integer
Dim intC As Integer
Const cN As String = "SHAPE"
With ActiveSheet
intC = .Shapes.Count
If intC = 0 Then
dhGetShapeName = cN & "01"
Exit Function
Else
i = intC + 1
Do Until dhShapeIs(cN & Format(i, "00")) = False
i = i + 1
Loop
intTemp = i
For j = intC To 1 Step -1
If dhShapeIs(cN & Format(intTemp, "00")) Then
intTemp = intTemp + 1
If dhShapeIs(cN & Format(intTemp, "00")) = False Then
Exit For
Else
intTemp = intTemp - 1
End If
Else
intTemp = intTemp - 1
End If
Next j
dhGetShapeName = cN & Format(intTemp, "00")
End If
End With
End Function
Private Function dhShapeIs(strN As String) As Boolean
'도형이 존재하는지 여부를 확인하는 사용자 정의 함수
On Error Resume Next
dhShapeIs = (Len(ActiveSheet.Shapes(strN).Name) >= 1)
On Error GoTo 0
End Function
그럼...행운이 있으시길...! |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
