Thank You
2016.03.07 14:32
Option Explicit
 
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
 
Type POINTAPI
    x As Long
    y As Long
End Type
 
Type esSetting
    lngSecond As Long '반복할 시간
    blnStart As Boolean '시작여부
    lngStep As Long '몇가지
    datEndTime As Date '종료시각
    lngPosition(1 To 5, 1 To 3) As Long '클릭할 위치
End Type
 
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Public gDatNow As Date
Public gSetting As esSetting
Public gStart As Boolean
 
Public Const Es As String = "MagicSheet & 엑사모"
 
Sub dhMain()
Dim s As Shape
    Set s = shtMain.Shapes("autoRun_icon")
    If gStart Then
        dhStop '중지하기
        gStart = False
        s.Visible = False
        Set s = Nothing
        Range("실행중").Value = Empty
        Exit Sub
    Else
    End If
    If dhCheckSetting Then
        gStart = True '시작하기...
        s.Visible = True
        Set s = Nothing
    Else
        Exit Sub
    End If
    
    MsgBox "5초 뒤 자동으로 실행합니다." & vbCr & vbCr & "클릭할 프로그램을 활성화하십시오!", vbInformation, Es
    Application.Wait Now() + TimeValue("00:00:05") '기다리기
    Range("실행중").Value = Format(Now, "HH:MM:SS") & "부터 실행중..."
    dhStart '시작
    
End Sub
 
Function dhCheckSetting() As Boolean
'설정이 제대로인지 확인
Dim i As Long
Dim j As Long
Dim k As Long
Dim strQ As String
 
    dhCheckSetting = False
    With Range("몇초마다")
        If IsEmpty(.Value) Then
            gSetting.lngSecond = 10
        Else
            If IsNumeric(.Value) Then
               gSetting.lngSecond = .Value
            Else
                .Value = 10
                gSetting.lngSecond = 10
            End If
        End If
    End With
    With Range("몇곳")
        If IsEmpty(.Value) Then
            gSetting.lngStep = 1
        Else
            If IsNumeric(.Value) Then
                gSetting.lngStep = .Value
                If gSetting.lngStep <= 0 Then
                    gSetting.lngStep = 1
                ElseIf gSetting.lngStep > 5 Then
                    gSetting.lngStep = 5
                Else
                End If
                .Value = gSetting.lngStep
            Else
                .Value = 1
                gSetting.lngStep = 1
            End If
        End If
    End With
    
   With Range("시작위치")
        strQ = "클릭할 위치를 지정하십시오!"
        For i = 1 To gSetting.lngStep '위치 확인
            For j = 1 To 3
                k = Choose(j, 0, 2, 4)
                If IsEmpty(.Offset(i, k).Value) Then
                    If j = 3 Then
                        gSetting.lngPosition(i, j) = 0
                    Else
                        dhMsg strQ, .Offset(i, k)
                        Exit Function
                    End If
                Else
                    If IsNumeric(.Offset(i, k).Value) Then
                        gSetting.lngPosition(i, j) = .Offset(i, k).Value
                    Else
                        dhMsg strQ, .Offset(i, k)
                        Exit Function
                    End If
                End If
            Next j
        Next i
        For i = 1 To gSetting.lngStep
            If gSetting.lngPosition(i, 3) < 0 Then
                gSetting.lngPosition(i, 3) = 0
            ElseIf gSetting.lngPosition(i, 3) > gSetting.lngSecond Then
                gSetting.lngPosition(i, 3) = gSetting.lngSecond
            Else
            End If
        Next i
    End With
    With Range("몇분뒤")
        If IsEmpty(.Value) Then
            gSetting.datEndTime = Now + DateSerial(Year(Date) + 1, Month(Date), Day(Date)) '1년 뒤
        Else
            If IsNumeric(.Value) Then
                If .Value <= 0 Then
                    gSetting.datEndTime = Now + DateSerial(Year(Date) + 1, Month(Date), Day(Date)) '1년 뒤
                Else
                    gSetting.datEndTime = Now + TimeSerial(0, .Value, 0)
                End If
            Else
                dhMsg "몇 분간 실행할 것인지 숫자 데이터로 입력하세요1", .Offset(0)
                Exit Function
            End If
        End If
    End With
    dhCheckSetting = True
End Function
 
Private Sub dhMsg(strQ As String, rngX As Range)
    rngX.Select
    MsgBox strQ, vbExclamation, Es
End Sub
 
 
Sub dhSetting()
'마우스 위치 설정하기
Dim i As Long
Dim lngW As Long
Dim blnAuto As Boolean
Dim rngTo As Range
Dim t As Long
Dim strQ As String
Dim blnStep As Boolean
Dim lngR As Long
Dim dhCursor As POINTAPI
Dim blnRun As Boolean
 
    blnAuto = CBool(Range("연속설정").Value = True) '연속설정
    Set rngTo = Range("시작위치")
    With Range("몇곳")
        If IsEmpty(.Value) Then
            lngW = 1
            .Value = lngW
        Else
            If IsNumeric(.Value) Then
                lngW = .Value
                If lngW > 5 Then
                    lngW = 5
                Else
                End If
                If lngW < 0 Then
                    lngW = 1
                Else
                End If
                If .Value <> lngW Then
                    .Value = lngW
                Else
                End If
            Else
                lngW = 1
                .Value = lngW
            End If
        End If
    End With
        
    If blnAuto Then
        
        For i = 1 To lngW
            If IsEmpty(rngTo.Offset(i, 0).Value) Then
            ElseIf IsEmpty(rngTo.Offset(i, 2).Value) Then
            Else
                If IsNumeric(rngTo.Offset(i, 0).Value) Then
                    If IsNumeric(rngTo.Offset(i, 2).Value) Then
                        t = t + 1
                    Else
                    End If
                Else
                End If
            End If
        Next i
        If t = lngW Then
            strQ = "이미 설정된 값이 있습니다. 새로 설정하시겠습니까?"
            strQ = MsgBox(strQ, vbYesNo + vbQuestion, Es)
            If strQ = vbNo Then Exit Sub
            blnStep = False
        Else
            If t = 0 Then
            Else
                blnStep = False
                strQ = "이미 설정된 값이 있는 경우가 있습니다."
                strQ = strQ & vbCr & "기존에 설정된 값은 건너 뛰시겠습니까?"
                strQ = MsgBox(strQ, vbYesNo + vbQuestion, Es)
                If strQ = vbYes Then
                    blnStep = True
                Else
                End If
            End If
        End If
        If blnStep Then '설정값 건너 뛰기
            For i = 1 To lngW
                blnRun = True
                If IsEmpty(rngTo.Offset(i, 0).Value) Then
                ElseIf IsEmpty(rngTo.Offset(i, 2).Value) Then
                Else
                    If IsNumeric(rngTo.Offset(i, 0).Value) Then
                        If IsNumeric(rngTo.Offset(i, 2).Value) Then
                            blnRun = False
                        Else
                        End If
                    Else
                    End If
                End If
                If blnRun Then '건너뛰어서 실행한 경우
                    lngR = rngTo.Row + i
                    dhSetPositionX lngR
                Else
                End If
            Next i
        Else '설정값 무시
           For i = 1 To lngW
                lngR = rngTo.Row + i
                dhSetPositionX lngR
            Next i
        End If
    Else
        strQ = Range(rngTo, rngTo.Offset(lngW, 2)).Address & "범위 중 한 곳을 선택하세요"
        If ActiveCell.Row > (rngTo.Row + lngW) Then
            MsgBox strQ, vbExclamation, Es
            rngTo.Offset(1, 0).Select
            Exit Sub
        Else
        End If
        If ActiveCell.Row <= rngTo.Row Then
            MsgBox strQ, vbExclamation, Es
            rngTo.Offset(1, 0).Select
            Exit Sub
        Else
        End If
        lngR = ActiveCell.Row
        dhSetPositionX lngR
    End If
    
 
End Sub
 
Private Sub dhSetPositionX(lngR As Long)
'마우스 위치를 기록합니다
Dim strQ As String
Dim dhCursor As POINTAPI
 
        strQ = "이 메시지의 확인 단추를 누른 뒤 " & vbCr & "5초 뒤에 마우스가 위치한 곳을 클릭할 곳으로 설정합니다!"
        MsgBox strQ, vbInformation, Es
            Application.Wait Now() + TimeValue("00:00:05") '대기
        GetCursorPos dhCursor
            shtMain.Cells(lngR, 3).Value = dhCursor.x
            shtMain.Cells(lngR, 5).Value = dhCursor.y
        AppActivate Application.Caption, False '설정한 뒤 되돌아 오기
End Sub
 
Sub dhStart()
 
If Now() >= gSetting.datEndTime Then
    dhCloseMe
    MsgBox "종료되었습니다!", vbInformation, Es
    Exit Sub
Else
End If
Dim i As Long
Dim k As Long
 
    gDatNow = Now() + TimeSerial(0, 0, gSetting.lngSecond) '몇 초 뒤
    With gSetting
        k = .lngStep
        For i = 1 To k
            SetCursorPos .lngPosition(i, 1), .lngPosition(i, 2) '좌표 설정
            dhMouseClick '마우스 클릭
            If .lngPosition(i, 3) <= 0 Then
            Else
                Application.Wait Now() + TimeSerial(0, 0, .lngPosition(i, 3)) '대기
            End If
        Next i
        gDatNow = Now() + TimeSerial(0, 0, .lngSecond)
    End With
    Application.OnTime gDatNow, "dhStart"  '반복
End Sub
 
Sub dhStop()
    '중지
On Error GoTo e1
    Application.OnTime EarliestTime:=gDatNow, _
    Procedure:="dhStart", Schedule:=False
    dhCloseMe
    MsgBox "중지 되었습니다!", vbInformation
e1:
End Sub
 
Private Sub dhCloseMe()
    gStart = False
    shtMain.Shapes("autoRun_icon").Visible = False
    AppActivate Application.Caption, False
    shtMain.Range("실행중").Value = Empty
End Sub
 
Sub dhMouseClick()
'마우스 클릭하기
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 '마우스 조작
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
문서 첨부 제한 : 0Byte/ 2.00MB
파일 제한 크기 : 2.00MB (허용 확장자 : *.*)