팁 : 다른 언어는 Google 번역입니다. 방문하실 수 있습니다. English 이 링크의 버전.
로그인
x
or
x
x
회원가입
x

or

Excel에서 지정한 셀 값에 따라 셰이프 크기 기반 / 종속성을 자동으로 변경하는 방법

지정된 셀의 값에 따라 모양 크기를 자동으로 변경하려면이 도움말을 참조하십시오.

VBA 코드로 지정된 셀 값을 기반으로 모양 크기 자동 변경


현재 Excel 통합 문서의 모든 셰이프 나열 및 내보내기 :

그래픽 내보내기 ~의 유용성 Excel 용 Kutools 현재 통합 문서의 모든 도형을 빠르게 나열하는 데 도움이됩니다. 모든 도형을 한 번에 특정 폴더로 내보낼 수 있습니다. 스크린 샷보기 :

Excel 용 Kutools 300 이상의 편리한 Excel 도구가 포함되어 있습니다. 60 일 동안 아무런 제한없이 시도해보십시오. 무료 평가판을 지금 다운로드하십시오.

Office 탭 Office에서 탭 편집 및 찾아보기를 사용하고 훨씬 쉽게 작업 할 수 있습니다 ...
Excel 용 Kutools는 대부분의 문제를 해결하고 생산성을 80 % 증가시킵니다.
  • 무엇이든 재사용하십시오 : 가장 많이 사용되거나 복잡한 수식, 차트 및 기타 항목을 즐겨 찾기에 추가하고 나중에 빠르게 재사용하십시오.
  • 20 이상의 텍스트 기능 : 텍스트 문자열에서 숫자 추출; 텍스트 일부 추출 또는 제거; 숫자와 통화를 영어 단어로 변환합니다.
  • 병합 도구: 여러 통합 문서 및 시트를 하나로 통합합니다. 데이터 손실없이 여러 셀 / 행 / 열 병합 중복 행 병합 및 합계
  • 분할 도구: 값을 기준으로 데이터를 여러 시트로 분할; 하나의 통합 문서에서 여러 Excel, PDF 또는 CSV 파일로; 하나의 열에서 여러 열로.
  • 건너 뛰기 붙여 넣기 숨겨진 / 필터링 된 행; 수와 합계 배경색 별; 여러 전자 메일 수신자에게 개인화 된 전자 메일 보내기
  • 수퍼 필터 : 고급 필터 구성표를 작성하고 모든 시트에 적용하십시오. 종류 주별, 일별, 빈도 등으로; FILTER 굵게, 수식, 주석으로 ...
  • 300 이상의 강력한 기능; Office 2007-2019 및 365와 호환됩니다. 모든 언어를 지원합니다. 기업이나 조직에 쉽게 배포 할 수 있습니다.

VBA 코드로 지정된 셀 값을 기반으로 모양 크기 자동 변경


다음 VBA 코드는 현재 워크 시트의 지정된 셀 값을 기반으로 특정 모양 크기를 변경하는 데 도움을줍니다. 다음과 같이하십시오.

1. 크기를 변경해야하는 셰이프가있는 시트 탭을 마우스 오른쪽 단추로 클릭 한 다음 코드보기 오른쪽 클릭 메뉴에서.

2. 에서 응용 프로그램 용 Microsoft Visual Basic 창에서 다음 VBA 코드를 복사하여 코드 창에 붙여 넣으십시오.

VBA 코드 : Excel의 지정된 셀 값을 기반으로 모양 크기 자동 변경

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

주의 사항: 코드에서 "타원형 2"모양의 이름은 크기를 변경할 것입니다. 과 행 = 2, 열 = 1 A2의 값으로 "타원형 2"모양의 크기가 변경됨을 의미합니다. 필요에 따라 변경하십시오.

다른 셀 값을 기반으로 여러 모양의 크기를 자동 조정하려면 아래 VBA 코드를 적용하십시오.

VBA 코드 : Excel에서 지정된 다른 셀의 값을 기반으로 여러 셰이프의 크기를 자동으로 조정합니다.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

노트:

1) 코드에서 "타원형 1","스마일 페이스 3"및"하트 3"모양은 자동으로 크기를 변경하는 이름입니다. 과 A1, A2A3 셀을 기반으로 모양의 크기를 자동으로 조정합니다.

2) 더 많은 도형을 추가하려면 "ElseIf xAddress = "A3"그런 다음"및 "Call SizeCircle ("Heart 2 ", Val (Target.Value))"첫 번째"END IF"코드에 삽입하고 필요에 따라 셀 주소와 모양 이름을 변경하십시오.

3. 프레스 다른 + Q 키를 동시에 눌러 응용 프로그램 용 Microsoft Visual Basic 창.

이제부터는 A2 셀의 값을 변경하면 Oval 2 모양의 크기가 자동으로 변경됩니다. 스크린 샷보기 :

또는 A1, A2 및 A3 셀의 값을 변경하여 "Oval 1", "Smiley Face 3"및 "Heart 3"의 모양을 자동으로 조정합니다. 스크린 샷보기 :

주의 사항: 셀 크기가 10보다 클 경우 모양 크기가 더 이상 변경되지 않습니다.


관련 기사 :


Excel 용 Kutools는 대부분의 문제를 해결하고 생산성을 80 % 증가시킵니다.

  • 재사용: 빠르게 삽입 복잡한 수식, 차트 그리고 당신이 전에 사용했던 것; 셀 암호화 비밀번호로; 메일 링리스트 만들기 그리고 이메일을 보내 ...
  • 슈퍼 포뮬러 바 (여러 줄의 텍스트와 수식을 쉽게 편집); 레이아웃 읽기 (많은 셀을 쉽게 읽고 편집); 필터링 된 범위에 붙여 넣기...
  • 셀 / 행 / 열 병합 데이터 손실없이; 분할 셀 내용; 중복 행 / 열 결합... 중복 세포 방지; 범위 비교...
  • 복제 또는 고유를 선택하십시오. 행; 빈 행 선택 (모든 세포는 비어있다); 슈퍼 찾기 및 퍼지 찾기 많은 통합 문서에서; 랜덤 선택 ...
  • 정확한 사본 공식 참조를 변경하지 않는 다중 셀; 참조 자동 작성 여러 장에; 글 머리 기호 삽입, 확인란 등 ...
  • 텍스트 추출, 텍스트 추가, 위치 별 제거, 공간 제거; 페이징 소계 생성 및 인쇄; 셀 내용과 주석 간 변환...
  • 수퍼 필터 (필터 구성표를 저장하고 다른 시트에 적용); 고급 정렬 월 / 주 / 일별, 빈도 등; 특수 필터 대담하고 기울임 꼴로
  • 통합 문서와 WorkSheets 결합; 키 열을 기준으로 테이블 병합 데이터를 여러 시트로 분할; 일괄 변환 xls, xlsx 및 PDF...
  • 300 이상의 강력한 기능. Office / Excel 2007-2019 및 365를 지원합니다. 모든 언어를 지원합니다. 기업이나 조직에 쉽게 배포 할 수 있습니다. 30 일 무료 평가판 전체 기능.
kte 탭 201905

Office 탭 Office에 탭 인터페이스를 제공하여 작업을 훨씬 쉽게

  • Word, Excel, PowerPoint에서 탭 편집 및 읽기 사용, 게시자, 액세스, Visio 및 프로젝트.
  • 새 창보다는 동일한 창에서 새 탭으로 여러 문서를 열고 만들 수 있습니다.
  • 50 %만큼 생산성을 높이고 매일 수백 번의 마우스 클릭을 줄입니다!
오피셜
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Chairil · 6 months ago
    Hi Crytal
    what if to determine the side of the cube, triangle, box that must be determined based on the length, width? Please help me

    Thank You
    chairil
    • To post as a guest, your comment is unpublished.
      crystal · 5 months ago
      Hi Chairil,
      Sorry can't help you with that yet. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    carol gomezgianine · 7 months ago
    Hi Crytal,

    I would like to ask you, if there is a way to select color (red cell = red form) and name from specific cells . could it also be possible to create forms automatically from VBA?

    Thank you so much in advance :)

    Carol


  • To post as a guest, your comment is unpublished.
    Andrew · 1 years ago
    Is there a way to do this with Images? I don't seem to be having any luck using the code as posted.

    5 Images in a leaderboard, I want the Images in 1st or tied for 1st to be larger. Therefore I've 2 fixed image sizes, either 1x2 for not first or 2x4 for 1st placed (for example). I've got ranking already set-up so can use that to create sizes in specific cells for each image (ie use an IF statement so IF RANK is 1st size width is 2). My VBA is pretty weak though.

    Basically I want - on sheet update - look at image size cells and set each image size to the specific image size cells result. I can't see in the VBA above how that exactly works but I think it should be easy!
  • To post as a guest, your comment is unpublished.
    Sam · 1 years ago
    Hi, is there a way that I can make the shape expand on two dimensions (instead of increasing the shape size by 5, increase it 5 on the horizontal and 3 on the vertical)?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Sam,
      The following VBA script can help you solve the problem. And the two dimensions are cell A1 and B1.

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Count = 1 Then
      If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
      Call SizeCircle("Oval 2", Array(Val(Range("A1").Value), Val(Range("B1").Value)))
      End If
      End If
      End Sub
      Sub SizeCircle(Name As String, Arr As Variant)
      Dim I As Long
      Dim xCenterX As Single
      Dim xCenterY As Single
      Dim xCircle As Shape
      On Error GoTo ExitSub
      For I = 0 To UBound(Arr)
      If Arr(I) > 10 Then
      Arr(I) = 10
      ElseIf Arr(I) < 1 Then
      Arr(I) = 1
      End If
      Next
      Set xCircle = ActiveSheet.Shapes(Name)
      With xCircle
      xCenterX = .Left + (.Width / 2)
      xCenterY = .Top + (.Height / 2)
      .Width = Application.CentimetersToPoints(Arr(0))
      .Height = Application.CentimetersToPoints(Arr(1))
      .Left = xCenterX - (.Width / 2)
      .Top = xCenterY - (.Height / 2)
      End With
      ExitSub:
      End Sub
  • To post as a guest, your comment is unpublished.
    Ian · 2 years ago
    Hi,
    I have tried to use your post to write my own VBA code but don't seem to be getting very far. Mainly because I don't really understand VBA and I'm just trying to adapt your. I was wondering if you could help. I am wanting to change the length of a rectangle depending on the value in a cell. I would like the width if the rectangle to stay the same but the length to change. I would like both left hand vertices to stay in the same place and it to lengthen to the right. Is this possible?
    Thank you
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear lan,
      Hope the following VBA code can solve your problem. (Please replace the Oval 1 with the shape name of your own)

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Row = 2 And Target.Column = 1 Then
      Call SizeCircle("Oval 1", Val(Target.Value))
      End If
      End Sub
      Sub SizeCircle(Name As String, Diameter)
      Dim xCircle As Shape
      Dim xDiameter As Single
      On Error GoTo ExitSub
      xDiameter = Diameter
      If xDiameter > 10 Then xDiameter = 10
      If xDiameter < 1 Then xDiameter = 1
      Set xCircle = ActiveSheet.Shapes(Name)
      xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
      With xCircle
      .LockAspectRatio = msoFalse
      .Width = Application.CentimetersToPoints(xDiameter)
      End With
      ExitSub:
      End Sub
  • To post as a guest, your comment is unpublished.
    Abhinaya · 2 years ago
    Hi, how do i replicate the same for multiple shapes linked to multiple cells in the same module?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Abhinaya,
      The article is updated with a new code section which can help you to execute with multiple shapes each depending on different cells. Thank you for your comment.

      Best Regards,
      Crystal
  • To post as a guest, your comment is unpublished.
    Ranjit Konkar · 2 years ago
    How do I name my shape? In your example above, how do you assign the name Oval 2 to the circle you have drawn?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Ranjit,
      For naming a shape, please select this shape, enter the shape name into the Name Box, and then press the Enter key. See below image shown.
  • To post as a guest, your comment is unpublished.
    Jade · 2 years ago
    How would you execute this with multiple shapes each depending on different cells?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Jade,
      The article is updated with a new code section which can help you to execute with multiple shapes each depending on different cells. Thank you for your comment.

      Best Regards,
      Crystal