반응형

https://tone.tistory.com/120

 

python 비활성 윈도우 이미지 캡쳐

다들 많이들 쓰는 nox... 회사에서 오토로 돌려놓으려니 오토 마우스는 해당 윈도우가 활성화 되어 있어야 하고 최소화는 아니더라도 비활성화 되어 있는건 이미지 캡쳐해서 클릭하고 싶은데 이

tone.tistory.com

에 이어서 이미지 캡쳐를 했으니 특정위치를 클릭하는 기능을 파이선으로 만들자

 

import win32api #핸들 처리
import win32con #입력 정보 관련

hwndclass ='Qt5QWindowIcon'
hwndname ='NoxPlayer'
hWnd = win32gui.FindWindow(hwndclass, hwndname)
if hWnd >=1:
	window_rect = win32gui.GetWindowRect(hWnd)
	print(window_rect) #해당 윈도우의 크기를 출력해보자
	lParam = win32api.MAKELONG(x, y)
	win32gui.SendMessage(hWnd, win32con.WM_LBUTTONDOWN, win32con.MK_LBUTTON, lParam) #마우스왼쪽 누르기
	win32gui.SendMessage(hWnd, win32con.WM_LBUTTONUP, None, lParam) #마우스왼쪽 떼기

win32gui.FindWindow 를 사용하는데 중요한 부분은

hwndclass ='Qt5QWindowIcon'
hwndname ='NoxPlayer'
hWnd = win32gui.FindWindow(hwndclass, hwndname)

다른 글들에서는 win32gui.FindWindow(none, 핸들이름) 으로 적혀있지만

녹스의 경우 해당 핸들의 클래스 까지 적어줘야 동작한다.

클래스는 가장 상단의 핸들의 클래스 값을 적어주자

 

반응형
반응형

★알파 플레이 시나리오
- 로비 화면에서 캐릭터 터치시 상세 정보, 배치 메뉴가 표시
-- 상세정보 : 각 캐릭터별 스탯과 스킬 정보를 표시
- 로비 화면의 비어 있는 슬롯을 터치, 배치 메뉴가 표시
-- 배치 가능한 병과 캐릭터 리스트가 나옴
-- 슬롯별 가능 캐릭터 1종(2번째 슬롯에 C캐릭터 배치 가능)

- 탐험을 터치시 층수 선택 화면, 스테이지는 옆으로 슬라이딩 된다.
-- 1층만 선택 가능, 다른 층수는 선택시 "아직 클리어하지 못한 지역입니다"

- 진입화면 블랙아웃 -> 화이트인
-- 캐릭터 대사창 표시 왼쪽에 A캐릭터, 오른쪽에 두번째 B캐릭터 
-- A캐릭터 컬러로 표시, 그리폰 회색으로표시됨
-- A캐릭터 대사(중얼중얼)
-- A캐릭터 회색, 그리폰 컬러
-- B캐릭터 대사(중얼중얼)
-- 전체 화면에서 B캐릭터 합류 표시(관련 내용..플레이 하면서 캐릭터 획득 가능내용)
- 1층 화면

- 플레이 시나리오
-- 이동하면서 앞에 있는 적을 처치 해서 경험치 획득 -> 레벨증가->레벨업 이펙트에서 최대량 증가 택스트 표시(증가 관련 설명)
-- 모든적을 저치시 다음 방으로 이동하는 문이 열린다.(해당 방의 우측 지역에 몬스터 배치)
-- 바닥에는 1층에는 톱날로 되어 있는 함정이 2단에는 이동플랫폼(움직이지 않음), 3단에는 A 와 B 캐릭터로는 못올라가는 고정플랫폼
-- 앞에 잡아 당기는 레버가 있다. 캐릭터가 가까이 가면 머리위에 위쪽 화살표가 표시 된다.
-- 위쪽으로 A 캐릭터로 진입 불가능한 지역이 있어 C캐릭터로 교체(캐릭터 변경 당위성 설명)
-- 레버를 당기면 레버는 더이상 활성화 되지 않고 2단의 이동플랫폼이 좌우로 왕복한다.

-- 점프하여 위에 있는 방으로 진입 바로 앞에 상자를 열어 아이템과 장비를 획득
-- 일시정지를 눌러 캐릭터에게 장착
-- 미니맵으로 해당 방의 끝 지역에 상자 확인 이동하여 자원 획득
-- 다른 외형으로 표시된 벽이 있는데 (B 캐릭터로 교체) 교체후 공격하면 루트 열림(탐험요소 + 캐릭터 변경 당위성 설명)
-- 숏컷문활성화,이용하여 1번 방으로 이동후 플레이(빠르게 이동 가능내용 설명)   == 이건 나중에??

-- 플레이중 제조시설에 도착,
-- 상호작용(위로) 제작 선택
-- 가능 장비,아이템 표시 및 구매

-- 캐릭터 인벤토리를 열고 해당 장비 터치 하여 장착
---- 장비 아이템은 최대 3개 장착 가능
---- 인벤토리는 공용

-- 보스룸 진입
----보스 출현 연출표시

-- 보스룸 클리어하면 보상 획득(크게 보여주자)
-- 다르게 생긴 숏컷문에서 상호작용하여 다음층으로 갈지 주둔지로 갈지 선택(알파에서는 주둔지만 활성화)


★ 플레이 주요사항
-- 전투 느낌
-- 플레이 방식

★ 플레이 주요 제작사항
-- 적NPC 와 충돌되어 피해를 입는다.
-- 피해를 입을 경우 데미지 연출이 표시 된다.(캐릭터가 하얀색 혹은 빨간색으로 칠해진후 알파값이 0.2초 간격으로 변경 0.5초 유지)
-- 캐릭터를 교체 하면 일정시간후 사용가능(교체시간은 캐릭터마다 다름)
-- 교체는 언제든지 가능하며 교체시 화면연출과 모든 적 탄환이 사라진다.+ 교체 지역에 데미지
-- 숏컷문이 있어서 클리어한 방의 숏컷문으로 다른지역으로 빠른이동가능(이건 애매)
-- 부서지는 벽(해야 하나..)

기믹. 공수 안들어가는 걸로 좋은거, 나쁜거
트리거 작동시키면 다리 생성..

 

흠...이렇게만 적어 놓으니 뭔가....

반응형
반응형

이것저것 하다보니 가상환경이 점차 늘어나게 된다

anaconda 로 추가 해도 되긴 하지만 용량이...(아니 용량을 걱정할 필요가 있나?;;)

 

-윈도우

생성 : python -m venv 가상환경이름

시작 : 가상환경 폴더로 들어간다음에 Scripts\activate.bat

종료 : Scripts\deactivate.bat

 

예시)

 

C:\pro>python -m venv test1
C:\pro>cd test1
C:\pro\test1>Scripts\activate.bat
(test1) C:\pro\test1>

추가사항)

윈도우 파워쉘에서는
PowerShell을 관리자로 실행한 뒤 Set-ExecutionPolicy RemoteSigned를 입력하고 Y를 입력).하고 해야 한다.

 

우분투

생성 : python3 -m venv test1
시작 : test1/bin/activate
종료 : deactivate

 

반응형
반응형

유니티 프로젝트를 진행하며 엑셀 데이터를 바이너리로 만들어야 하는 경우가 발생

 

클라이언트 분이 만들어 주시긴 하지만

유니티 켜기가 싫다!!

 

만들자!!

Public Const strTitle = "noti"          '박스 타이틀
Public Const msgCellsErr = " 셀에 오류가 있어 데이터 생성을 중단합니다."
Public Const msgNotDataSheet = "데이터 시트 테이블이 아니어서 프로세스를 종료합니다."

Option Explicit
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (hpvDest As Any, _
    hpvSource As Any, _
    ByVal cbCopy As LongPtr)

'utf8 변환
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long) As Long

Private Declare PtrSafe Function MultiByteToWideChar Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long _
    ) As Long
#Else

    Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

'utf8 변환
    Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpWideCharStr As Long, _
        ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As Long, _
        ByVal cbMultiByte As Long, _
        ByVal lpDefaultChar As Long, _
        ByVal lpUsedDefaultChar As Long _
        ) As Long
#End If


'바이트로 변환을 위해 각 타입별로 바이트 변수 지정
Private Type ByteLong
    value(3) As Byte
End Type
 
Private Type TypedLong
    value As Long
End Type

Private Type ByteByte
    value(0) As Byte
End Type

Private Type TypedByte
    value As Byte
End Type

'타입별로 바이트 array 로 변환하는 펑션
Function LongToByteArray(ByVal value As Long) As Byte()
      'Purpose: Converts a variable of the type Long to a byte array.
    Dim tlJump As TypedLong
    Dim blJump As ByteLong
    tlJump.value = value
    LSet blJump = tlJump
    LongToByteArray = blJump.value
End Function


Function ByteToByteArray(ByVal value As Long) As Byte()
      'Purpose: Converts a variable of the type Long to a byte array.
    Dim tlJump As TypedByte
    Dim blJump As ByteByte
    tlJump.value = value
    LSet blJump = tlJump
    ByteToByteArray = blJump.value
End Function



Function SingToByte(ByVal D As Single) As Byte()
    Dim Bytes(LenB(D) - 1) As Byte
    Dim I As Integer
    Dim S As String
    CopyMemory Bytes(0), D, LenB(D)
    For I = 0 To UBound(Bytes)
        S = S & CStr(Bytes(I)) & " "
    Next
    SingToByte = Bytes
End Function


Sub bytes_export_Click(control As IRibbonControl) 'bytes Export 버튼 클릭시 실행될 내용

    Call CDataD

End Sub

Sub bytes_Allexport_Click(control As IRibbonControl) 'All bytes Export 버튼 클릭시 실행될 내용
    Dim sht As Worksheet

    For Each sht In Worksheets
        If sht.Name <> "info" Then
            Call CreateData(sht.Name, 1)
        End If
    Next sht
    
    MsgBox ThisWorkbook.Path & "\" & "bytes" & "\" & Chr(10) & "데이터 익스포트 완료", Title:=strTitle
End Sub



'어....어디서 가져왔더라...여튼 바이트를 utf8 변환하는 코드

'utf8 변환
Public Function Utf8BytesFromString(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    ' Catch empty or null input string
    Utf8BytesFromString = vbNullString
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    Utf8BytesFromString = abBuffer
End Function
''' Return length of byte array or zero if uninitialized

'utf8 관련
Private Function BytesLength(abBytes() As Byte) As Long
    ' Trap error if array is uninitialized
    On Error Resume Next
    BytesLength = UBound(abBytes) - LBound(abBytes) + 1
End Function

''' Return VBA "Unicode" string from byte array encoded in UTF-8
Public Function Utf8BytesToString(abUtf8Array() As Byte) As String
    Dim nBytes As Long
    Dim nChars As Long
    Dim strOut As String
    Utf8BytesToString = ""
    ' Catch uninitialized input array
    nBytes = BytesLength(abUtf8Array)
    If nBytes <= 0 Then Exit Function
    ' Get number of characters in output string
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
    ' Dimension output buffer to receive string
    strOut = String(nChars, 0)
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
    Utf8BytesToString = Left$(strOut, nChars)
End Function

'중복키값체크

Sub checkDulpicatePrimarykey(str_SheetName As String)
    
    On Error Resume Next

    Dim int_CNT As Long
    Dim int_Temp As Integer
    Dim I, j As Integer
    
    int_CNT = Application.CountA(Worksheets(str_SheetName).Range("A:A"))
    
    Uf_status.Show
    Uf_status.Caption = "PrimaryKey 중복 체크 중"
    
    For I = 4 To int_CNT
        
        '기본 키 비교
        
        int_Temp = Application.CountIfs(Worksheets(str_SheetName).Range("A:A"), Worksheets(str_SheetName).Cells(I, 1) & "*", Worksheets(str_SheetName).Range("A:A"), Worksheets(str_SheetName).Cells(I, 1))
            
        If int_Temp > 1 Then

            MsgBox Worksheets(str_SheetName).Name & " 시트 " & I & " 열의 ID 가 중복됩니다." & Chr(10) & Chr(34) & Cells(I, 1) & Chr(34), Title:=strTitle
            Unload Uf_status
            Exit Sub

        End If

        Uf_status.lbl_status.Width = 210 / int_CNT * I
        Uf_status.lbl_status_string = Int(I / int_CNT * 100) & " % " & "(" & I & "/" & int_CNT & ")"
        Uf_status.Repaint
    
    Next I
    
    Unload Uf_status
    
End Sub

'헤더체크

Sub checkDulpicateHeader(str_SheetName As String) '헤더 중복 체크
    
    Dim int_CNT As Long
    Dim int_Temp As Integer
    Dim I, j As Integer
    
    Uf_status.Show
    Uf_status.Caption = "필드명 중복 체크 중"

    int_CNT = Application.CountA(ActiveSheet.Range("3:3"))
    
    For I = 1 To int_CNT
    
        '내부 사용을 위해 기울임꼴 처리된 항목 배제
        If ActiveSheet.Cells(3, I).Font.FontStyle = "기울임꼴" Or ActiveSheet.Cells(3, I).Font.FontStyle = "굵은 기울임꼴" Then
        
        Else
    
            int_Temp = Application.CountIf(Range("3:3"), Cells(3, I))
    
            If int_Temp > 1 Then
    
                MsgBox Worksheets(str_SheetName).Name & " 시트 " & I & " 행의 이름이 중복됩니다." & Chr(10) & Chr(34) & Worksheets(str_SheetName).Cells(3, I) & Chr(34), Title:=strTitle
                Unload Uf_status
                Exit Sub
    
            End If
    
            Uf_status.lbl_status.Width = 210 / int_CNT * I
            Uf_status.lbl_status_string = Int(I / int_CNT * 100) & " % " & "(" & I & "/" & int_CNT & ")"
            Uf_status.Repaint
    
        End If
                
    Next I
    
    Unload Uf_status

End Sub

실제 데이터 찍는곳
Sub CDataD()

Dim str_TempRng As String
    
    '시트이름에 data_ 가 없으면 데이터 테이블 시트가 아닌 경우 종료
    'If UCase(Left(ActiveSheet.Name, 5)) = "DATA_" Then
    If ActiveSheet.Name <> "info" Then
        str_TempRng = DetectErr(ActiveSheet.Name)
        
        If str_TempRng <> "" Then
            MsgBox str_TempRng & msgCellsErr, Title:=strTitle
            GoTo Err
        End If
            '별도 프로시저를 호출
            Call CreateData(ActiveSheet.Name, 0)
        Exit Sub

        Else
            MsgBox msgNotDataSheet, Title:=strTitle
    End If
    
Err:
End Sub
'에러 발생시 오류 메시지 출력
Function DetectErr(str_SName As String)

    Dim rng_Temp As Object

    On Error Resume Next

    Set rng_Temp = Worksheets(str_SName).Cells.SpecialCells(xlCellTypeFormulas, 16)

    If rng_Temp Is Nothing Then
    
    
    Else
    
        DetectErr = Worksheets(str_SName).Cells.SpecialCells(xlCellTypeFormulas, 16).Address
    
    End If

    Set rng_Temp = Worksheets(str_SName).Cells.SpecialCells(xlCellTypeConstants, 16)
    
    If rng_Temp Is Nothing Then
    
    
    Else
    
        DetectErr = DetectErr + Worksheets(str_SName).Cells.SpecialCells(xlCellTypeConstants, 16).Address
    
    End If

End Function

' 한글 완성형 문자열의 바이트 수 구하기 함수
Function LenMbcs(ByVal str As String)
  LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

'실제 시트 데이터 반복 부분
Sub CreateData(str_SheetName As String, ci As Integer)
    
    

    Dim str_Path As String

    Dim str_sSheetName As String
    Dim byteName As String

    Dim int_NFields As Integer
    Dim int_NData, var_Tempindex As Long
    
    Dim I, j As Long '셀 반복
    
    Dim Body As Object
    
    Dim var_TempType, var_TempValue
    Dim var_TempLong As Long

    Dim var_TempString As String
    Dim var_Tempbyte() As Byte
    Dim var_Tempbyte2 As Byte
    Dim var_TempPrebyte() As Byte
    Dim var_TempFloat As Single
    Dim str_workPath As String
    Dim ck_dir As Boolean
    
    

    '중복키값 체크
    Call checkDulpicatePrimarykey(str_SheetName)
    Call checkDulpicateHeader(str_SheetName)

   ' 저장 폴더 존재 여부 체크 후 없다면 생성
   If Dir("D:\work\DataTables\", vbDirectory) = "" Then
        If Dir(ThisWorkbook.Path & "\" & "bytes" & "\", vbDirectory) = "" Then
            
            MkDir ThisWorkbook.Path & "\" & "bytes" & "\"
            ck_dir = False
        End If
    Else
        ck_dir = True
        
    End If
    '시트 명으로 .bytes 파일명 지정, 안해도 되지만 프로그래머분이 이름을 다르게 쓰니 뭐...
    If str_SheetName = "string_ui" Then
        byteName = "StringUITable"
        ElseIf str_SheetName = "weapon_info" Or str_SheetName = "fxList" Then
            If str_SheetName = "weapon_info" Then byteName = "WeaponObj"
            If str_SheetName = "fxList" Then byteName = "Effect"
            byteName = byteName & "Table"
        Else
        byteName = UCase(Left(str_SheetName, 1))
        If InStr(1, str_SheetName, "_") Then
            ' _ 있는 시트명 처리
            byteName = byteName & Mid(str_SheetName, 2, InStr(1, str_SheetName, "_") - 2)
            
            byteName = byteName & UCase(Mid(str_SheetName, InStr(1, str_SheetName, "_") + 1, 1)) _
                & Mid(str_SheetName, InStr(1, str_SheetName, "_") + 2, Len(str_SheetName))
            Else
                '_ 없는 시트명 처리
                byteName = UCase(Left(str_SheetName, 1)) & Mid(str_SheetName, 2, Len(str_SheetName))
        End If
        

        byteName = byteName & "Table"
    End If
    str_Path = ThisWorkbook.Path & "\" & "bytes" & "\" & byteName & ".bytes"
    str_workPath = "D:\work\DataTables\" & byteName & ".bytes"
    '이전파일이 있다면 삭제
    If Dir(str_Path) <> vbNullString Then
        Kill str_Path
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '.bytes 생성
    
    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    
    Set Body = CreateObject("ADODB.Stream")
    Body.Type = 1
    Body.Open

    'sheet 의 사이즈를 확인하고
    int_NFields = Application.CountA(Worksheets(str_SheetName).Range("1:1"))
    int_NData = Application.CountA(Worksheets(str_SheetName).Range("a:a"))
    
    'sheet 내용을 bytes 로 변환
'    'header 입력
'    For j = 1 To int_NFields
'
'        'sheet 의 내용 중 데이터에 들어가지 않는 것 필터링,  글꼴이 기울임이면 제외
'        If Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "기울임꼴" Or Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "굵은 기울임꼴" Then
'        Else
'            If str_Target = vbNullString Then
'                str_Target = Worksheets(str_SheetName).Cells(3, j).value
'            Else
'                str_Target = str_Target & "," & Worksheets(str_SheetName).Cells(3, j).value
'            End If
'        End If
'    Next j
'
'    Body.WriteText = str_Target & Chr(10)
'    str_Target = ""

    Dim Ndata_c As Long
    
    '키 개수 입력
    Ndata_c = 0
    For I = 4 To int_NData
        If Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "기울임꼴" Or Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "굵은 기울임꼴" Then
        
        Else
            Ndata_c = Ndata_c + 1
        End If
    Next I
    Body.Write LongToByteArray(Ndata_c)
    'body 입력
    
    For I = 4 To int_NData
        If Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "기울임꼴" Or Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "굵은 기울임꼴" Then
        '기본키 내용 중 기울임꼴인것 필터
        Else
            For j = 1 To int_NFields
                If Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "기울임꼴" Or Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "굵은 기울임꼴" Then
                'sheet 의 내용 중 데이터에 들어가지 않는 것 필터링
                
                Else

                    '필드 내용 확인후 쓰기
                    var_TempType = UCase(Worksheets(str_SheetName).Cells(1, j).value)
                    var_TempValue = Worksheets(str_SheetName).Cells(I, j).value
                    If var_TempType = "INT" Then
                    'int 오버플로우 체크
                        If var_TempValue < -2147483648# Or var_TempValue > 2147483647 Then
                            If var_TempValue <> "" Then MsgBox Worksheets(str_SheetName).Name & " " & Worksheets(str_SheetName).Cells(I, j).Address & " 셀의 값(" & var_TempValue & ")이 범위를 넘었습니다(" & var_TempType & ").", Title:=strTitle
                            'int 타입일 때 "" value 에 대한 예외처리
                            Else
                                'int 타입일 때 처리
                                If str_SheetName = "monster_group" And j = int_NFields Then
                                
                                var_TempLong = Worksheets(str_SheetName).Cells(I, j).value
                                Body.Write LongToByteArray(var_TempLong)
                                
                                var_TempPrebyte = StrConv(Chr(255), vbFromUnicode)
                                Body.Write var_TempPrebyte
                                Body.Write var_TempPrebyte
                                Body.Write var_TempPrebyte
                                Body.Write var_TempPrebyte
                                Else
                                var_TempLong = Worksheets(str_SheetName).Cells(I, j).value
                                Body.Write LongToByteArray(var_TempLong)
                                End If
                        End If


                    ElseIf var_TempType = "BYTE" Then
                    'byte 오버플로우 체크
                        If var_TempValue < -1 Or var_TempValue > 256 Then
                            'byte 타입일 때 "" value 에 대한 예외처리
                            If var_TempValue <> "" Then MsgBox Worksheets(str_SheetName).Name & " " & Worksheets(str_SheetName).Cells(I, j).Address & " 셀의 값(" & var_TempValue & ")이 범위를 넘었습니다(" & var_TempType & ").", Title:=strTitle
                            Else
                            'byte 타입일 때 처리
                            var_Tempbyte2 = Worksheets(str_SheetName).Cells(I, j).value
                            Body.Write ByteToByteArray(var_Tempbyte2)
                        End If
                            
                        
                    ElseIf var_TempType = "STRING" Then
                    'string 인경우
'                        var_TempString = Chr(Len(Worksheets(str_SheetName).Cells(I, j).value)) + Worksheets(str_SheetName).Cells(I, j).value
'                        var_Tempbyte = StrConv(var_TempString, vbFromUnicode)
                        
                        'utf8 변환
                        var_TempString = Worksheets(str_SheetName).Cells(I, j).value
                        var_Tempbyte = Utf8BytesFromString(var_TempString)

                        'var_TempPrebyte = StrConv(Chr(LenMbcs(Worksheets(str_SheetName).Cells(I, j).value)), vbFromUnicode)
                        var_TempPrebyte = StrConv(Chr(UBound(var_Tempbyte) - LBound(var_Tempbyte) + 1), vbFromUnicode)
                        Body.Write var_TempPrebyte
                        Body.Write var_Tempbyte
                    
                    ElseIf var_TempType = "FLOAT" Then
                    
                    'float 인경우
                        var_TempFloat = Worksheets(str_SheetName).Cells(I, j).value
                        var_Tempbyte = SingToByte(var_TempFloat)
                        Body.Write var_Tempbyte
                    
                    End If
                    
'                    '줄바꿈이 있거나, 콤마(,)가 있을 때 별도 처리
'                    If InStr(var_TempValue, Chr(10)) > 0 Or InStr(var_TempValue, ",") > 0 Then
'
'                        var_TempValue = """" & var_TempValue & """"
'
'                    End If
'
'                    If str_Target = vbNullString Then
'                        str_Target = var_TempValue
'                    Else
'                        str_Target = str_Target & "," & var_TempValue
'
'                        'str_Target = str_Target & "," & Worksheets(str_SheetName).Cells(3, j).Value
'
'                    End If
                            
                End If
            
            Next j
        
'            Body.WriteText = str_Target & Chr(10)
'            str_Target = ""
        End If
    Next I
    
    If ck_dir Then
        Body.savetofile str_workPath, adSaveCreateOverWrite
        Else
        Body.savetofile str_Path, adSaveCreateOverWrite
    End If
    Body.Close
    If ci <> 1 And ck_dir Then
        MsgBox str_workPath & Chr(10) & "데이터 익스포트 완료", Title:=strTitle
        
        Else
        MsgBox str_Path & Chr(10) & "데이터 익스포트 완료", Title:=strTitle
    End If
    
End Sub

Sub xls_export_Click(control As IRibbonControl) 'xls Export 버튼 클릭시 실행될 내용
    
    Call CreateXls
    MsgBox ThisWorkbook.Path & "\" & "xls" & "\" & Chr(10) & "xls 생성완료", Title:=strTitle
End Sub

Sub CreateXls()

    
    Dim sht As Worksheet
    Dim str_Path As String '저장 파일명
    Dim ob As Workbook '이전 워크북
    Dim wb As Workbook '생성워크북
    Dim str_SheetName As String
    
    Dim int_NFields As Integer
    Dim int_NData As Long
    Dim var_TempType, var_TempValue
    
    Dim I, j As Long '셀 반복
    
    Set ob = Application.ActiveWorkbook
    
    ' 저장 폴더 존재 여부 체크 후 없다면 생성
    If Dir(ob.Path & "\" & "xls" & "\", vbDirectory) = "" Then
        MkDir ob.Path & "\" & "xls" & "\"
    End If
    
    '워크북 명으로로 .xls 파일명 지정
    str_Path = ob.Path & "\" & "xls" & "\" & CreateObject("Scripting.FileSystemObject").GetBaseName(ob.Name) & "1.xlsx"
    
    '이전파일이 있다면 삭제
    If Dir(str_Path) <> vbNullString Then
        Kill str_Path
    End If
    
    
    '파일생성
    Set wb = Application.Workbooks.Add
    
    For Each sht In ob.Worksheets
        'If sht.Name <> "info" Then
        str_SheetName = sht.Name
        '중복키값 체크
        Call checkDulpicatePrimarykey(str_SheetName)
        Call checkDulpicateHeader(str_SheetName)
        Sheets.Add
        Sheets(1).Name = str_SheetName
        
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'sheet 복사
        int_NFields = Application.CountA(ob.Worksheets(str_SheetName).Range("1:1"))
        int_NData = Application.CountA(ob.Worksheets(str_SheetName).Range("a:a"))

        For I = 1 To int_NData
            If ob.Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "기울임꼴" Or ob.Worksheets(str_SheetName).Cells(I, 1).Font.FontStyle = "굵은 기울임꼴" Then
            '기본키 내용 중 기울임꼴인것 필터
            Else
                For j = 1 To int_NFields
                    If ob.Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "기울임꼴" Or ob.Worksheets(str_SheetName).Cells(3, j).Font.FontStyle = "굵은 기울임꼴" Then
                    'sheet 의 내용 중 데이터에 들어가지 않는 것 필터링
                    
                    Else
                        '필드 내용 확인후 쓰기
                        var_TempType = UCase(ob.Worksheets(str_SheetName).Cells(1, j).value)
                        var_TempValue = ob.Worksheets(str_SheetName).Cells(I, j).value
                        If var_TempType = "INT" Then
                        'int 오버플로우 체크
                            If I >= 4 Then
                                If var_TempValue < -2147483648# Or var_TempValue > 2147483647 Then
                                    If var_TempValue <> "" Then MsgBox ob.Worksheets(str_SheetName).Name & " " & ob.Worksheets(str_SheetName).Cells(I, j).Address & " 셀의 값(" & var_TempValue & ")이 범위를 넘었습니다(" & var_TempType & ").", Title:=strTitle
                                    'int 타입일 때 "" value 에 대한 예외처리
                                    Else
                                    'int 타입일 때 처리
                                    wb.Sheets(str_SheetName).Cells(I, j).value = ob.Worksheets(str_SheetName).Cells(I, j).value
                                End If
                                Else
                                wb.Sheets(str_SheetName).Cells(I, j).value = ob.Worksheets(str_SheetName).Cells(I, j).value
                            End If
                        ElseIf var_TempType = "STRING" Or var_TempType = "TXT" Then
                            'string 인경우
                            wb.Sheets(str_SheetName).Cells(I, j).value = ob.Worksheets(str_SheetName).Cells(I, j).value
    
                        ElseIf var_TempType = "FLOAT" Then
                        
                        'float 오버플로우 체크
                            If I >= 4 Then
                                If var_TempValue < -2147483648# Or var_TempValue > 2147483647 Then
                                    If var_TempValue <> "" Then MsgBox ob.Worksheets(str_SheetName).Name & " " & ob.Worksheets(str_SheetName).Cells(I, j).Address & " 셀의 값(" & var_TempValue & ")이 범위를 넘었습니다(" & var_TempType & ").", Title:=strTitle
                                    'int 타입일 때 "" value 에 대한 예외처리
                                    Else
                                    wb.Sheets(str_SheetName).Cells(I, j).value = ob.Worksheets(str_SheetName).Cells(I, j).value
                                End If
                                Else
                                'float 일때 처리
                                wb.Sheets(str_SheetName).Cells(I, j).value = ob.Worksheets(str_SheetName).Cells(I, j).value
                            End If
                        
                        End If
                    End If
                Next j
            End If
        Next I

    Next sht
    
    '알림 메시지 비활성화
    Application.DisplayAlerts = False
    '자동 생성된 시트 1 삭제
    wb.Sheets("sheet1").Delete
    
    '알림 메시지 활성화
    Application.DisplayAlerts = True
    
    '저장
    wb.SaveAs str_Path
    wb.Close
    MsgBox str_Path & Chr(10) & "데이터 익스포트 완료", Title:=strTitle
    
End Sub

 

음......괴랄해....

항상 느끼는 거지만 왜하고 있는거지...

반응형
반응형

다들 많이들 쓰는 nox...

회사에서 오토로 돌려놓으려니 오토 마우스는 해당 윈도우가 활성화 되어 있어야 하고

최소화는 아니더라도 비활성화 되어 있는건 이미지  캡쳐해서 클릭하고 싶은데

 

이미지 캡쳐가 안된다

 

그럼 뭐? 구글링 해서 만들어야지 뭐

 

일단 현재 캡쳐하려는 녹스윈도우의 핸들이름을 알아야 하니

spy .zip
3.43MB

spy++ 를 사용해서 이름을 찾자(나중에 UI 로 만들어서 선택하도록 해야지..)

압축을 해제한후 spyxx.exe 를 실행

윈도우 서치 버튼을 눌러 나오는 팝업에서 조준선을 드래그하여 확인하려는 윈도우 에 드랍합니다.

가장 최상단의 윈도우 핸들이 필요합니다.

최상단의 윈도우를 우클릭후 'Properties...' 를 클릭하면 상세 정보 화면이 표시 됩니다.

윈도우 캡션의 데이터(3)를 메모해 두고 파이선 작업을 시작합니다.

#-*-coding:utf-8  
#한글 입력을 위한 정의

import win32gui 
import win32ui
#윈도우 핸들을 찾기 위한 라이브러리
#pip install pypiwin32
#anconda환경이라면 conda install -c anaconda pywin32
from PIL import Image
#이미지저장을 위한 라이브러리
#pip install pillow

from ctypes import windll
#윈도우 dll사용을 위한 라이브러리

hwndname ='NoxPlayer3'
hwnd = win32gui.FindWindow(None, hwndname)
if hwnd >=1:
    left, top, right, bot = win32gui.GetWindowRect(hwnd)
    w = right - left
    h = bot - top
    hwndDC = win32gui.GetWindowDC(hwnd)
    mfcDC  = win32ui.CreateDCFromHandle(hwndDC)
    saveDC = mfcDC.CreateCompatibleDC()

    saveBitMap = win32ui.CreateBitmap()
    saveBitMap.CreateCompatibleBitmap(mfcDC, w, h)

    saveDC.SelectObject(saveBitMap)

    result = windll.user32.PrintWindow(hwnd, saveDC.GetSafeHdc(), 0)

    bmpinfo = saveBitMap.GetInfo()
    bmpstr = saveBitMap.GetBitmapBits(True)
    im = Image.frombuffer('RGB',(bmpinfo['bmWidth'], bmpinfo['bmHeight']), bmpstr, 'raw', 'BGRX', 0, 1)
    win32gui.DeleteObject(saveBitMap.GetHandle())
    saveDC.DeleteDC()
    mfcDC.DeleteDC()
    win32gui.ReleaseDC(hwnd, hwndDC)
    
if result ==1: 
    #성공적으로 윈도우 값을 가져왔다면
    im.save("test.png")
    #이미지저장

가려져 있어도 정상적으로 해당 윈도우의 이미지를 가져온다.

최소화 되어 있었다면 아래와 같이 타이틀 바만 저장된다.

성공적으로 test.png로 저장된다.

이제 이미지 서치와 서치한 좌표를 클릭(비활성 클릭)하도록 만들기만 하면된다.

 

나중에 업무 자동화 같은데 사용할수 있겠지?;;; 아마도???

 

반응형
반응형

C# (유니티?) 엔진 및 이펙트, 타격타이밍 등을 json 으로 저장하게 되면서

json 파일 정보를 엑셀에서 정리해야 되는 경우가 발생

+ json 파일이 줄바꿈되어 있지 않은 경우

+ 추가기능을 추가 하지 않고 파싱하여 가져와 보자

 

원본 json데이터 : "c:\eff.json"

 


{"target": [{"stateName": "ShortAttack","effectName": "vfx_hit_01_yellow","effectBulletName": "","boneName": "Bip001 Pelvis","startboneName": "","ftime": 0.25699999928474429,"fAngle": [],"isMelee": true,"fAngleX": [],"bulletCount": 0,"selectStartBoneidx": 0,"selectBoneidx": 3,"selectidx": 1,"objEffect": {"instanceID": 71280},"objBulletEffect": {"instanceID": 0}},{"stateName": "LongAttack","effectName": "fx_hit_laser_01_green","effectBulletName": "fx_laser_01_green","boneName": "Bip001 Pelvis","startboneName": "dummy_attack_long_01","ftime": 0.38999998569488528,"fAngle": [0.0],"isMelee": false,"fAngleX": [0.0],"bulletCount": 1,"selectStartBoneidx": 79,"selectBoneidx": 3,"selectidx": 2,"objEffect": {"instanceID": 67170},"objBulletEffect": {"instanceID": 58998}},{"stateName": "Smash","effectName": "vfx_hit_01_yellow","effectBulletName": "","boneName": "Bip001 Pelvis","startboneName": "","ftime": 0.5569999814033508,"fAngle": [],"isMelee": true,"fAngleX": [],"bulletCount": 0,"selectStartBoneidx": 0,"selectBoneidx": 3,"selectidx": 10,"objEffect": {"instanceID": 71280},"objBulletEffect": {"instanceID": 0}}]}

 

 

보는것과 같이 한줄로 주욱....되어 있는 경우가 대부분이다.

이걸 json 뷰어등으로 파싱하면..

{
  "target": [
    {
      "stateName": "ShortAttack",
      "effectName": "vfx_hit_01_yellow",
      "effectBulletName": "",
      "boneName": "Bip001 Pelvis",
      "startboneName": "",
      "ftime": 0.25699999928474429,
      "fAngle": [
        
      ],
      "isMelee": true,
      "fAngleX": [
        
      ],
      "bulletCount": 0,
      "selectStartBoneidx": 0,
      "selectBoneidx": 3,
      "selectidx": 1,
      "objEffect": {
        "instanceID": 71280
      },
      "objBulletEffect": {
        "instanceID": 0
      }
    },
    {
      "stateName": "LongAttack",
      "effectName": "fx_hit_laser_01_green",
      "effectBulletName": "fx_laser_01_green",
      "boneName": "Bip001 Pelvis",
      "startboneName": "dummy_attack_long_01",
      "ftime": 0.38999998569488528,
      "fAngle": [
        0.0
      ],
      "isMelee": false,
      "fAngleX": [
        0.0
      ],
      "bulletCount": 1,
      "selectStartBoneidx": 79,
      "selectBoneidx": 3,
      "selectidx": 2,
      "objEffect": {
        "instanceID": 67170
      },
      "objBulletEffect": {
        "instanceID": 58998
      }
    },
    {
      "stateName": "Smash",
      "effectName": "vfx_hit_01_yellow",
      "effectBulletName": "",
      "boneName": "Bip001 Pelvis",
      "startboneName": "",
      "ftime": 0.5569999814033508,
      "fAngle": [
        
      ],
      "isMelee": true,
      "fAngleX": [
        
      ],
      "bulletCount": 0,
      "selectStartBoneidx": 0,
      "selectBoneidx": 3,
      "selectidx": 10,
      "objEffect": {
        "instanceID": 71280
      },
      "objBulletEffect": {
        "instanceID": 0
      }
    }
  ]
}

이런 모양이 된다.

 

표로 보자면

 

target/stateName target/effectName target/effectBulletName target/boneName target/startboneName target/ftime target/isMelee target/bulletCount target/selectStartBoneidx target/selectBoneidx target/selectidx target/objEffect/instanceID target/objBulletEffect/instanceID target/fAngle/0 target/fAngleX/0
ShortAttack vfx_hit_01_yellow   Bip001 Pelvis   0.25699999928474426 true 0 0 3 1 71280 0    
LongAttack fx_hit_laser_01_green fx_laser_01_green Bip001 Pelvis dummy_attack_long_01 0.38999998569488525 false 1 79 3 2 67170 58998 0 0
Smash vfx_hit_01_yellow   Bip001 Pelvis   0.5569999814033508 true 0 0 3 10 71280 0    

 

여기서 내가 필요한것은

각 "stateName" 별 이벤트 발생시간 "ftime" 값이다.

 

Private p&, token, dic

Sub jsonDataRead()
	Set Arry = CreateObject("Scripting.Dictionary")
    Dim bb As Integer
	filename = "c:\eff.json"
	Open filename For Input As #1
        Do Until EOF(1)
			Line Input #1, textline
			Total = Total & vbNewLine & textline
		Loop
	Close #1
    If InStr(1, Total, vbCrLf) >= 1 Then 	'줄바꿈 되어 있는 데이터를 한줄로
    	Total = Replace(Total, vbCrLf, vbLf)
    End If
    Set Arry = ParseJSON(Total)
    For Each aa In Arry.keys '키기준으로 돌리자
    	If InStr(1, aa, "stateName") Then
          Fileline = Application.CountA(range("a:a")) 'a열 숫자 카운트 해서 다음에 넣자
          ActiveWorkbook.Activeworksheets.Cells(Fileline + 1, 1).Value = Arry.Items()(bb) 'aa
    	ElseIf InStr(1, aa, "ftime") Then
    		ActiveWorkbook.Activeworksheets.Cells(Fileline + 1, 2).Value = Arry.Items()(bb) 'aa
    	End If
    	bb = bb + 1
    Next
End Sub
'---------------------------------------------------------------------------
' VBA JSON Parser 도구 참조 추가 하지 않는  파서 Dictionary 형식으로 반환
'---------------------------------------------------------------------------

Function ParseJSON(json$, Optional key$ = "obj") As Object
    p = 1
    token = Tokenize(json)
    Set dic = CreateObject("Scripting.Dictionary")
    If token(p) = "{" Then ParseObj key Else ParseArr key
    Set ParseJSON = dic
End Function

Function ParseObj(key$)  '키 분해
    Do: p = p + 1
        Select Case token(p)
            Case "]"
            Case "[":  ParseArr key
            Case "{":  ParseObj key
            Case "}":  key = ReducePath(key): Exit Do
            Case ":":  key = key & "." & token(p - 1)
            Case ",":  key = ReducePath(key)
            Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
        End Select
    Loop
End Function

Function ParseArr(key$) '키 배열
    Dim e&
    Do: p = p + 1
        Select Case token(p)
            Case "}"
            Case "{":  ParseObj key & ArrayID(e)
            Case "[":  ParseArr key
            Case "]":  Exit Do
            Case ":":  key = key & ArrayID(e)
            Case ",":  e = e + 1
            Case Else: dic.Add key & ArrayID(e), token(p)
        End Select
    Loop
End Function

'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s$) '값 토큰화
    Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
    Tokenize = RExtract(s, Pattern, True)
End Function

Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True) '값 추출
  Dim c&, m, n, v
  With CreateObject("vbscript.regexp")
    .Global = bGlobal
    .MultiLine = False
    .IgnoreCase = True
    .Pattern = Pattern
    If .test(s) Then
      Set m = .Execute(s)
      ReDim v(1 To m.Count)
      For Each n In m
        c = c + 1
        v(c) = n.Value
        If bGroup1Bias Then If Len(n.submatches(0)) Or n.Value = """""" Then v(c) = n.submatches(0)
      Next
    End If
  End With
  RExtract = v
End Function

Function ArrayID$(e) '값 배열
    ArrayID = "(" & e & ")"
End Function

Function ReducePath$(key$) '값패스 정리
    If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1)
End Function



 

Arry Dictionary 의 구조

변수 Arry에  Dictionary로 저장후 Arry.keys 로 for을 진행

 

Arry keys

원하는 항목 검사 InStr(1, aa, "빼내고자 하는 항목명") 해서

액티브 시트에 찍기

 

음...나중에도 쓸만하겠지?

반응형
반응형

뭐 회사 일까지는 아니고 개인적으로 각 차트의 순위를 보려고 만듬


1. 파이선으로 웹 에서 정보 가져옴

2. txt 파일로 만듬

3. 엑셀에서 읽옴

4. 각 날자별 시트 생성후 저장

5. 함수 적절히 해서 순위 나오게 함



함수는 

=IFERROR(MATCH(C$4,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!"&CHAR(64+MATCH(G$5,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!$1:$1"),0))&":"&CHAR(64+MATCH(G$5,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!$1:$1"),0))),0)-1,IFERROR(MATCH(C$4,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!"&CHAR(64+MATCH(H$5,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!$1:$1"),0))&":"&CHAR(64+MATCH(H$5,INDIRECT("'"&$F113&IF($G$3="안드로이드"," and"," ios")&"'"&"!$1:$1"),0))),0)-1,"없음"))


매크로 하기 싫어서 함수로 하니 괘랄한 아이가 나옴 ㅋㅋㅋㅋㅋㅋㅋ


나중에 정보확인용으로 저장~


중간에 주말 데이터가 없는건 일자 변경시 자동기능 않넣어서 그럼 ㅋㅋㅋㅋ 


나만볼껀데 뭐 상관없지 ㅋㅋㅋㅋ


어라? 근데 용량 겁나 작네...쳇...



반응형
반응형

와....xml 을 했더니 이제는 텍스트가 날 괴롭히네...


일반 적인 형식으로 읽으면 문자가 다 깨져서 objStream 으로 읽어야 한다..


Private Sub Read()


filename = "c:\text.txt"

Dim objStream As Object '읽어올 objStream 을 만들고

Set objStream = CreateObject("ADODB.Stream") 'objStream 을 ADODB.Stream으로 생성

objStream.Open ' 열고

objStream.Type = 2 'adTypeText '텍스트 타입

objStream.Charset = "UTF-8" '캐릭터셋을 utf-8로

objStream.LoadFromFile filename '오브젝트 스트림에 파일을 로드

Do Until objStream.EOS '오브젝트 스트림이 종료시까지 반복

strLine = objStream.ReadText(-2)  ' strLine에 한줄씩 넣기

Loop


End Sub


별거 아닌데 은근 꽤 찾아야 나오더라는..;;

반응형
반응형

관리가 필요한 엑셀파일(테이블) 들이 늘어남에 따라


수정이 필요한 경우 각 엑셀파일을 열어서 메크로를 수정 해야 되는 문제 발생

(문제라기 보다는 귀찮은거지 뭐)


공통 코드 서식파일을 만들어서 엑셀파일을 열때 서식을 열어서 사용하도록 하자!


음....근데 서식을 하려고 하니 각 엑셀에 버튼을 만들어줘야 하는 게 또 걸리네..


리본메뉴 추가다!!!



OfficeCustomUIEditorSetup 를 다운받아 설치 합니다.


OfficeCustomUIEditorSetup.msi


(닷넷 프레임워크 3.0 이 필요하다고 나오면서 링크로 연결되더군요)


아무것도 적혀있지 않은 엑셀파일하나를 생성합니다.


이후 Custom UI Editor For Microsoft Office 를 실행한 후


File-Open 으로 해당 엑셀파일을 열어 줍니다.


<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">

<ribbon>

<tabs>

<tab id="customTab" label="NewBorn">

<group id="customGroup" label="Xml Tools">

<button id="customButton1"

  label="Xml Export"

imageMso="XmlExport"

size="large"

onAction="ButtonClick" />

<button id="customButton2"

  label="csv Export"

imageMso="ExportTextFile"

size="large"

onAction="ButtonClick2" />

</group>


</tab>

</tabs>

</ribbon>

</customUI>


추가적인 내용은 엑사모를 참고

http://www.examo.co.kr/tn/board.php?board=qqqtip&config=4&page=4&command=body&no=1149



나야 뭐 엑셀 익스포트랑 csv 익스포트만 있으면 되니 메뉴 구성을 저렇게 만듬


Alt+F11 을 눌러 VBA 연다

모듈을 추가 하고

Sub ButtonClick(control As IRibbonControl) 'xml 버튼 클릭시실행될 내용

MsgBox "xml 버튼누름"

End Sub


Sub ButtonClick2(control As IRibbonControl) 'csv 버튼 클릭시 실행될 내용

MsgBox " 버튼누름"

End Sub


다른 이름으로 저장 시 "Excel 추가기능" 을 선택하여 저장


하면 사용자 메뉴.xlam 엑셀 서식 파일이 생성된다.


대상 엑셀에


Sub Auto_open()

strPath = ThisWorkbook.Path

 Workbooks.Open Filename:=strPath & "\사용자메뉴.xlam"

End Sub


를 해서 열때 마다 서식파일을 열도록 하면 끝


 ps. 리본 이미지는 이 파일로..

OfficeCustomUIEditorSetup.msi



반응형
반응형

항상 엑셀로 데이터 관리하다보니 실제 xml 에 값이 없더라는

어이없는 경우가 발생


그럼? 펑션으로 해서 있는지를 체크하면되겠넹? ㅋㅋ


예시)AAA.xml 


<?xml version="1.0" encoding="UTF-8" standalone="yes"?>

<base>

<macro_name>

  <key>2</key>

  <text>으하하하</text>   

</macro_name>

<macro_name>

<key>3</key>

<text>우헤헤헤</text>

</macro_name>

</base>


셀에 2라는 값이 있을때 text 의 값을 얻어와보자


ALT+F11 키눌러서 vba 창에서 도구 -> 참조 에서 Microsoft XML, v3.0 을 활성화 먼저 한다.

(안그러면 xml 안읽히더라고...6.0도 있던데 되는지는 안해봄)






Function xmlfind(key) '함수처럼 사용하기 위해 이름 주고, 셀값 저장)


    Dim XmlDoc As DOMDocument: Dim blnXml As Boolean 'xml 문서형식 지정, 체크값


    Dim strFileName As String: strFileName = "AAA.xml" ' 파일명


    Dim strPath As String: strPath = "c:\"& strFileName 'strPath에 폴더위치와 파일명


    Dim strMsg As String: strMsg = strPath & "파일을 불러오다가 에러가 발생했습니다."


    Set XmlDoc = CreateObject("Microsoft.XMLDom") '오브젝트로 지정


    blnXml = XmlDoc.Load(strPath) '파일있는지 확인


    Dim i As Integer, j As Integer '반복을 위한 변수 설정

    If blnXml = True Then '파일읽었다면?


        With XmlDoc.ChildNodes(1) '문서 끝가지 반복

        For i = 0 To .ChildNodes.Length - 1 '첫번째 노드 key 의 끝까지 반복

            If key = .ChildNodes(i).ChildNodes(0).Text Then 'key 가 셀값과 같은가?

                xmlfind = .ChildNodes(i).ChildNodes(1).Text '해당 노드 값을 반환

                Exit For

            End If

        Next i

        End With

        Set XmlDoc = Nothing 'xml 껏졍

    Else

xmlfind =  strMsg & vbCrLf & Err.Number & " : " _

                   & Err.Description   '오류시 오류사항 리턴

    End If

End Function


언제나 느끼지만 나 이거 왜하고 있는거지....

반응형

+ Recent posts