2019년 9월 11일 수요일

Excel Vba Sheet 내용을 Text 파일로 저장하기 (UTF-8)

시트의 내용을 텍스트 파일로 저장하기. (UTF-8 대응)
Sub SheetToText()

    Dim streamWrite As New ADODB.Stream '// 쓰기 스트림 선언 Microsoft ADODB 6.1 (ActiveX) 참조 필수
    Dim sText       As Variant          '// 파일 데이터 선언

    
    '// 파일 쓰기
    streamWrite.Type = adTypeText
    streamWrite.Charset = "UTF-8"
    streamWrite.Open
    
    '// 첫줄에 넣을 메시지
    streamWrite.WriteText "// 첫줄"
    
    '//시트 데이터 읽는데 필요한 변수 선언
    Dim rng As Range
    Dim iRow As Long, iCol As Integer
    Dim sTxt As String, sPath As String, deLimiter As String
    Set rng = ActiveSheet.UsedRange

    deLimiter = ", "     '// 구분자 "," 입력 바꿔도 됨

    For iRow = 1 To rng.Rows.Count  '// 1행부터 마지막 행까지
        For iCol = 1 To rng.Columns.Count  '// 1열부터 오른쪽 최대 열까지
            sTxt = sTxt & ActiveSheet.Cells(iRow, iCol).Value & deLimiter
        Next iCol
        streamWrite.WriteText (Left(sTxt, Len(sTxt) - 1) & vbLf)

       sTxt = vbNullString
    Next iRow
    
    
    '// 스트림의 마지막 표시
    streamWrite.SetEOS
    
    '// 세이브
    Call streamWrite.SaveToFile(Application.ActiveWorkbook.Path + "\" + ActiveSheet.Name + ".txt", adSaveCreateOverWrite) '//저장할 경로와 파일 이름은 필요에 따라 변경할 것
    
    '// 스트림 클로즈
    streamWrite.Close
    
End Sub

EXCEL VBA로 euc-kr -> utf-8로 변경하는 코드

EXCEL VBA로 텍스트 쓸 때 이미 써진 파일을 euc-kr -> utf-8 로 수정하는 코드
'Microsoft ActiveX Data Objects 6.1 Library 참조 필요

Private Sub EuckrToUtf8NoBOM(a_sFrom, a_sTo)

    Dim streamRead  As New ADODB.Stream '// 읽을 데이터
    Dim streamWrite As New ADODB.Stream '// 작성할 데이터
    Dim sText       As Variant          '// 파일 데이터
    
    '// 파일데이터
    streamRead.Type = adTypeText
    streamRead.Charset = "euc-kr" '여기에 한글형을 입력한다.
    streamRead.Open
    Call streamRead.LoadFromFile(a_sFrom)
    
    '// 개행코드 CRLF를 LF로 변환
    sText = streamRead.ReadText
    sText = Replace(sText, vbCrLf, vbLf)
    
    '// 파일쓰기
    streamWrite.Type = adTypeText
    streamWrite.Charset = "UTF-8"
    streamWrite.Open
    
    '// euc-kr 을 utf-8 데이터로 쓴다.
    Call streamWrite.WriteText(sText)
    
    '// 바이너리 모드로 쓴 데이터 시작 위치를 BOM분의 3바이트씩 민다.
    streamWrite.Position = 0
    streamWrite.Type = adTypeBinary
    streamWrite.Position = 3
    
    '// 3바이트 민 상태에서 데이터를 취득
    sText = streamWrite.Read
    
    '// 3바이트 민 위치를 원래대로 돌린다.
    streamWrite.Position = 0
    
    '// BOM이 제거된 데이터를 처음부터 다시 쓴다.
    Call streamWrite.Write(sText)
    
    '// 현시점의 말미를 끝으로, 직전에 쓴 3바이트를 데이터 대상외로 한다.
    streamWrite.SetEOS
    
    '// 저장
    Call streamWrite.SaveToFile(a_sTo, adSaveCreateOverWrite)
    
    '// 파일 닫기
    streamRead.Close
    streamWrite.Close
End Sub

EXCEL VBA 텍스트 파일 저장하기 (출력하기)

data 코드의 일부를 자동 생성해주는 스크립트 만들 때 유용하다.
Option Explicit

Sub Createtextfile()


Dim TF As Object
Dim TFT As Object

'만들기
Set TF = CreateObject("scripting.filesystemobject")
Set TFT = TF.Createtextfile(Application.ActiveWorkbook.Path + "\l10n.js")

'Debug.Print (Application.ActiveWorkbook.Path)

'내용넣기
TFT.WriteLine "this is just test file" & vbCr & "afs"
TFT.WriteLine "this is 2nd line of test file"
TFT.WriteLine ActiveSheet.Name

'닫기
TFT.Close
Set TF = Nothing
Set TFT = Nothing

End Sub

2019년 9월 10일 화요일

Windows 10에서 시작 프로그램 (윈도우 켜질 때 같이 시작되는 프로그램 추가하는 방법)

윈도우 + R 키 누르면 나오는 실행창에 아래와 같이 입력하면 탐색기가 열린다.

shell:startup


탐색기가 열리면, 어떤 폴더를 가리키고 있을 것인데, 
거기에 바로가기나 단독으로 실행 가능한 exe 파일을 복사하면ㄷ된다.

2019년 8월 20일 화요일

Excel 모든 시트 셀 내용만 지우기

아래의 스크립트를실행한다.
Sub 모든시트내용지우기()

         Dim WS_Count As Integer
         Dim i As Integer

         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For i = 1 To WS_Count

            ' 여기에 원하는 코드를 넣는다. 열린 파일에 숨긴 시트가 있으면 에러날 때가 있음
            Debug.Print ("시트 변경함 : " + ActiveWorkbook.Worksheets(i).name)
            ActiveWorkbook.Worksheets(i).Select 
            Cells(1, 1).Select
            
            '모든 셀 내용 삭제
            Cells.Select
            Selection.ClearContents

         Next i

End Sub

2019년 7월 26일 금요일

vba 로 color=#ffffff 태그 깨진 것 찾기

시간이 너무 없었다.

태그가 어디에서 깨졌는지 모르겠는데, 처리해야 할 스트링 양이너무 많았다.

남은시간은 30분 정도...

그래서 TAG verifty 관련하여 vba 툴을 검색하다가 시간이 없어서 대충 몇가지 조건으로 거르도록 했다.
아래는 3가지 조건이다.

1. TAG 꺽쇄가 짝수인가.
2. TAG가 OPEN CLOSE 로 구성되어있는가.
3. TAG 에 알 수 없는 다양한 미스로 인해 결과문에 태그의 일부가 노출되는가.

아래 코드는 부끄럽지만, 빠르게 확인해보기 위한 것이니까 그냥 작성했다.
에러가 발생한 내용에는 "#COLOR_TAG_ERROR"를 담아 리턴하기로 한다.


Function checkColorTagVerify(str_)
' "Microsoft VBScript Regular Expressions 5.5"  를 선택하고 실행하여야한다

'검사할 문장
Dim sText As String
sText = str_

'태그 꺽쇄 갯수를 찾아서 나머지가 발생하면 에러로 간주
Dim charactercountA As Integer
Dim charactercountB As Integer

charactercountA = Len(str_) - Len(Replace(str_, "<", ""))
charactercountB = Len(str_) - Len(Replace(str_, ">", ""))

'Debug.Print (charactercountA)
'Debug.Print (charactercountB)

If charactercountA Mod 2 > 0 Then
sText = "#COLOR_TAG_ERROR"
End If

If charactercountB Mod 2 > 0 Then
sText = "#COLOR_TAG_ERROR"
End If

'혹시 모를 나머지 검사...
Dim find_ As Integer '시작 태그 깨짐으로 color= 만 남는 경우
Dim find2_ As Integer '끝 태그 깨짐으로 /color 만 남는 경우
Dim find3_ As Integer '시작태그는 있는데 끝 태그가 없는 경우,
Dim find4_ As Integer '시작태그는 있는데 끝 태그가 없는 경우의 반대

'Debug.Print (sText)


find3_ = InStr(sText, " 0 And find4_ = 0 Then
    sText = "#COLOR_TAG_ERROR"
End If

If find4_ > 0 And find3_ = 0 Then
    sText = "#COLOR_TAG_ERROR"
End If


'정규식 시작

Dim regEx
Set regEx = New RegExp

regEx.Pattern = "<[^>]+>"  '--- html tag match를 위한 정규식
regEx.IgnoreCase = True
regEx.Global = True
sText = regEx.Replace(sText, "")

'Debug.Print sText

'정규식 끝


find_ = InStr(sText, "color=")
find2_ = InStr(sText, "/color")

If find_ > 0 Then
    sText = "#COLOR_TAG_ERROR"
End If

If find2_ > 0 Then
    sText = "#COLOR_TAG_ERROR"
End If

checkColorTagVerify = sText

End Function



테스트결과







2019년 7월 1일 월요일

Excel 파일 Compare 하기

COM 추가기능에 Inquire 를 추가하면 Excel 파일을 비교하는 기능을 사용할 수 있다.

Inquire 추가 방법