ExcelAutomation/VisualBasic

UserPreferences

1. 모든 워크 시트 내의 특정 셀 출력하기
2. 특정 셀 데이터를 텍스트 파일에다 쓰기.
3. XLS 파일을 CSV 파일로 변환하기
4. 이미지 집어넣기
5. 행 높이, 열 폭 변경하기

1 모든 워크 시트 내의 특정 셀 출력하기

'On Error Resume Next

Dim xlApp
Dim xlBook
Dim xlSheet
Dim xlRange
Dim i

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.WorkBooks.Open("test.xls")

For Each xlSheet In xlBook.Sheets 
    For row=1 To 2 'xlSheet.Rows.Count
        For col=1 To 2 'xlSheet.Columns.Count
            WScript.Echo "(" & xlSheet.Name & "," & row & "," & col & ")=" & xlSheet.Cells(row, col)
        Next
    Next

    i = i + 1 
Next 

xlBook.close False
xlApp.quit

2 특정 셀 데이터를 텍스트 파일에다 쓰기.

Dim xlApp 'Excel.Application
Dim xlBook 'Excel.Workbook
Dim xlSht 'Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.WorkBooks.Open("test.xls")
Set xlSht = xlApp.activesheet

iRet = WriteResultFile(xlSht.Cells(1, 1).Value)
xlBook.close False
xlApp.quit

function WriteResultFile(strResult)
    const ForReading=1, ForWriting=2, ForAppending=8
    Dim fso, ts

    set fso = CreateObject("Scripting.FileSystemObject")
    set ts = fso.OpenTextFile("test.txt", ForWriting, True)
    ts.WriteLine(strResult)
    ts.Close
    WriteResultFile = 0
end function

3 XLS 파일을 CSV 파일로 변환하기

CsvFileProcessing 페이지도 참고하기 바란다.


On Error Resume Next

Dim xlApp
Dim xlBook
Dim xlSheet
Dim xlRange
Dim fso, file
Dim line, total
Dim XLSName, CSVName

const ForReading=1, ForWriting=2, ForAppending=8 

If WScript.Arguments.Count <> 2 Then
    WScript.Echo "Usage : convert.vbs excel_filename csv_filename"
    WScript.Quit
End If

Set XLSName = WScript.Arguments.Item(0)
Set CSVName = WScript.Arguments.Item(1)

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set xlBook = xlApp.WorkBooks.Open(XLSName)

Set fso = CreateObject("Scripting.FileSystemObject") 
Set file = fso.OpenTextFile(CSVName, ForWriting, True) 

For Each xlSheet In xlBook.Sheets  
    For row=2 To 10 'xlSheet.Rows.Count

        total = 0
        For col=1 To 15
            total = total + Len(xlSheet.Cells(row, col))
        Next
        
        If total = 0 Then Exit For
        
        line =        CSV(xlSheet.Cells(row,  1)) & "," '클래스
        line = line & CSV(xlSheet.Cells(row,  2)) & "," '타입
        line = line & CSV(xlSheet.Cells(row,  3)) & "," '이름
        line = line & CSV(xlSheet.Cells(row,  4)) & "," '가격
        line = line & CSV(xlSheet.Cells(row,  5)) & "," '최소
        line = line & CSV(xlSheet.Cells(row,  6)) & "," '최대
        line = line & CSV(xlSheet.Cells(row,  7)) & "," '스타일
        line = line & CSV(xlSheet.Cells(row,  8)) & "," '계절
        line = line & CSV(xlSheet.Cells(row,  9)) & "," '배색
        line = line & CSV(xlSheet.Cells(row, 10)) & "," '노출
        line = line & CSV(xlSheet.Cells(row, 11)) & "," '레이어
        line = line & CSV(xlSheet.Cells(row, 12)) & "," '범프
        line = line & CSV(xlSheet.Cells(row, 13)) & "," '속성
        line = line & CSV(xlSheet.Cells(row, 14)) & "," '메시
        line = line & CSV(xlSheet.Cells(row, 15))       '텍스쳐
        
        file.WriteLine(line)
    Next
Next

file.Close 
xlBook.close False
xlApp.quit

WScript.Echo "변환 완료"


' 임의의 셀을 CSV 형식으로 변환하기 위한 함수 
Function CSV(text) 
    Dim QuoteIndex 
    Dim CommaIndex 
    Dim LineFeedIndex
    Dim Result 
     
    Result        = text 
    QuoteIndex    = InStr(1, Result, """") 
    CommaIndex    = InStr(1, Result, ",") 
    LineFeedIndex = InStr(1, Result, VBLF) 
 
    If QuoteIndex <> 0 OR CommaIndex <> 0 OR LineFeedIndex <> 0 Then 
        While QuoteIndex <> 0 
            Result = Mid(Result, 1, QuoteIndex) & """" & Mid(Result, QuoteIndex+1) 
            QuoteIndex = InStr(QuoteIndex+2, Result, """") 
        Wend 
        Result = """" & Result & """" 
    End If 
     
    CSV = Result 
End Function 

4 이미지 집어넣기

Dim xlApp
Dim xlBook
Dim xlRange

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

Set xlBook = xlApp.WorkBooks.Open("d:\iteminfo.xls")

Set xlRange = xlApp.Range("A1")
InsertPicture xlApp.ActiveSheet, "d:\BED.BMP", xlRange, True, True

xlBook.close True '변경된 사항을 저장하고, 닫는다.
xlApp.quit

' 대상이 되는 셀에다가 이미지를 집어넣는다.
Sub InsertPicture(sheet, filename, cell, centerH, centerV)
    Dim picture
    Dim top
    Dim left
    Dim width
    Dim height
    
    ' import picture
    Set picture = sheet.Pictures.Insert(filename)
    
    ' 이미지 크기를 변경할 수 있다.
    'picture.Width = 100
    'picture.Height = 100
    
    ' determine positions
    top = cell.Top
    left = cell.Left
    
    If centerH Then
        width = cell.Offset(0, 1).Left - cell.Left
        left = left + width / 2 - picture.Width / 2
        If l < 1 Then l = 1
    End If
    
    If centerV Then
        height = cell.Offset(1, 0).Top - cell.Top
        top = top + height / 2 - picture.Height / 2
        If top < 1 Then top = 1
    End If
    
    ' position picture
    picture.Top = top
    picture.Left = left
    
    Set picture = Nothing
End Sub

5 행 높이, 열 폭 변경하기

Sub SetColumnWidth(sheet, col, width)
    If col < 1 OR col > 256 Then Exit Sub
    sheet.Columns(col).ColumnWidth = width
End Sub

Sub SetRowHeight(sheet, row, height)
    If row < 1 OR row > 65536 Then Exit Sub
    sheet.Rows(row).RowHeight = height
End Sub

• see also VisualBasic
  

• CategoryAutomation, CategoryTools