ActiveX 컨트롤로 작동하는 Excel의 단추가 모양으로 바뀌어야합니다. 이제는 작동하지 않습니다. 100 %

Question

트래커 용 activex 단추를 만들었습니다. 직장에서의 빌드로 임명되었습니다. 나는 그것을 내보낼 때 무한한 호환성과 권한 문제가있었습니다. 대신 매크로 사용 가능 모양으로 만들기로 결정했습니다. 그것은 당신이 그것을 클릭 할 때 현재 시간과 날짜를 현재 셀에 입력하는 간단한 버튼으로되어 있습니다. 그게 작동, 문제는 그것이 더 이상 떠 다니는 것처럼 그것은 activex 버튼이었을 때, 그것은 페이지 아래쪽에있는 활성 셀을 따르지 않는다는 것입니다. 또한 - 액티브 X가 아니기 때문에 버튼 클릭을 시뮬레이트하지 않습니다. 코드를 넣으려고하는데, 은으로 보입니다.하지만 클릭 할 때 우울증은 없습니다. 여기 내가 지금까지 가지고있는 것이있다.

Sub RectangleRoundedCorners1() 
Dim vTopType As Variant 
Dim iTopInset As Integer 
Dim iTopDepth As Integer 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     vTopType = .BevelTopType 
     iTopInset = .BevelTopInset 
     iTopDepth = .BevelTopDepth 
    End With 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = msoBevelSoftRound 
     .BevelTopInset = 12 
     .BevelTopDepth = 4 
    End With 
    Application.ScreenUpdating = True 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = vTopType 
     .BevelTopInset = iTopInset 
     .BevelTopDepth = iTopDepth 
    End With 
End Sub 

Sub RectangleRoundedCorners1_Click() 
    ActiveCell.Value = Now() 
    ActiveCell.NumberFormat = "MM/DD/YY hh:mm:ss" 
End Sub 

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
    With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn) 
     RectangleRoundedCorners1.Top = .Top + 10 
     RectangleRoundedCorners1.Left = .Left + 825 

    End With 
End Sub 

Answer 1

셰이프 개체에는 ActiveX 개체와 같은 메서드가 없습니다. 또한 VB 내부가 아닌 Excel 통합 문서에만 존재하기 때문에 개체와 동일한 이름의 메서드를 만들어 참조 할 수 없습니다. 당신은 그 두 개의 서브를 하나로 합친 다음 버튼을 오른쪽 버튼으로 클릭하고 "Assign Macro ..."옵션을 사용하여 그 서브를 그것에 할당 할 수 있습니다. 는 IT가 시트에 따라 점점에 관해서는

Sub ButtonClick() 
Dim vTopType As Variant 
Dim iTopInset As Integer 
Dim iTopDepth As Integer 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     vTopType = .BevelTopType 
     iTopInset = .BevelTopInset 
     iTopDepth = .BevelTopDepth 
    End With 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = msoBevelSoftRound 
     .BevelTopInset = 12 
     .BevelTopDepth = 4 
    End With 
    Application.ScreenUpdating = True 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = vTopType 
     .BevelTopInset = iTopInset 
     .BevelTopDepth = iTopDepth 
    End With 

    ActiveCell.Value = Now() 
    ActiveCell.NumberFormat = "MM/DD/YY hh:mm:ss" 
End Sub 

, 당신은 (이 코드는 워크 시트 당신의 버튼에 대한 모듈 내부에 있어야합니다) 첫번째 모양 객체에 대한 유효한 참조를 얻을 필요가있다.

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 

Dim shButton As Shape 

Set shButton = Shapes("RectangleRoundedCorners1") 

With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn) 
    shButton.Top = .Top + 10 
    shButton.Left = .Left + 825 
End With 

End Sub 

Answer 2

모양에 변화는 인간의 눈으로는 거의 볼 수 없음을 너무 빨리 발생합니다. 사용자가 키 클릭을 인식 할 수 있도록 변경 사항을 충분히 오래 유지하기 위해 for 루프를 두었습니다.

워크 시트 모듈이 아닌 일반 모듈에 다음 코드를 입력하십시오. 이 셰이프와 관련된 모든 워크 시트 모듈 코드를 삭제하십시오.

마우스 오른쪽 버튼으로 모양을 클릭하고 "매크로 지정"을 일반 모듈의 여기에 추가하십시오. 사용자가 스크롤 할 때 제 위치에 머물게하는 방법을 모르지만 적어도 시각적 인 문제를 해결할 것입니다.

또한 셀 A1에 날짜가 변경되었습니다.

Sub RectangleRoundedCorners1() 
Dim vTopType As Variant 
Dim iTopInset As Integer 
Dim iTopDepth As Integer 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     vTopType = .BevelTopType 
     iTopInset = .BevelTopInset 
     iTopDepth = .BevelTopDepth 
    End With 

For i = 1 To 70 
' This change happens too quickly for the eye to see 
' Put a small for loop so the visual change can be seen 
    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = msoBevelSoftRound 
     .BevelTopInset = 12 
     .BevelTopDepth = 4 
     .Visible = True 
    End With 
    Application.ScreenUpdating = True 
    ActiveSheet.Shapes(Application.Caller).ThreeD.Visible = True 
Next i 

    With ActiveSheet.Shapes(Application.Caller).ThreeD 
     .BevelTopType = vTopType 
     .BevelTopInset = iTopInset 
     .BevelTopDepth = iTopDepth 
    End With 


    ActiveSheet.Range("A1").Value = Format(Now(), "mmm dd, yyyy") 

End Sub