[VB] VB에서 엑셀파일 쓰기(윤곽선, 정렬, 폰트, 사이즈)

[VB] VB에서 엑셀파일 쓰기

'업무에서 데이터와 스프레드에 입력된 데이터들을 엑셀파일로 옮기는 작업의 일부를

'긁어왔습니다. 도움이 되었으면 좋겠습니다.

'코드 중간중간에 기능에 대한 설명을 주석으로 남겨놓았습니다.

'궁금한 사항이 있으시면 댓글로 남겨주세요.

 

Private Sub mMakeExcel()

    Dim oExcel  As Object

    Dim oBook   As Object

    Dim oSheet  As Object

    Dim pType       As String

    Dim pTxt        As String

    Dim pTmpDt(10)  As String

    Dim pCnt    As Integer

    Dim N       As Integer

    Dim M       As Integer

    Dim pLen    As Integer

     

    '새로운 Excel 객체 생성

    Set oExcel = CreateObject("Excel.Application")

    Set oBook = oExcel.Workbooks.Open("\\Nas_station\Kis_erp\InvoiceExcel\" & pType & ".xls")

 

    'Open한 Excel 파일의 sheet 객체 선언

    Set oSheet = oBook.Worksheets(1)

 

    oSheet.Range("J3").value = "#" & gSales.tSInvoice             '해당 셀 데이터 입력

    oSheet.Range("J3").Font.Bold = True                               '굵게 표시

    oSheet.Range("J3").Font.Color = &H817E78                      '글씨색

    oSheet.Range("J3").Font.Name = "맑은 고딕"                    '글씨 폰트설정

    oSheet.Range("J3").Font.Size = 10                                  '글씨 Size

 

    oSheet.Range("A8").value = gSales.tConsigness

    oSheet.Range("A8").HorizontalAlignment = xlHAlignLeft      '왼쪽 정렬

    oSheet.Range("A8").Font.Size = 10

   

    oSheet.Range("E8").value = gSales.tRemit

    oSheet.Range("E8").HorizontalAlignment = xlHAlignRight     '오른쪽 정렬

    oSheet.Range("E8").Font.Size = 10

 

 

 

    '하단 스프레드 데이터

    With fpSpread

        For N = 1 To pCnt

            For M = 1 To 10

                .Row = N: .Col = M: pTmpDt(M) = Trim(.Text)

            Next

            If pType = "A" Or pType = "A1" Then

                oSheet.Range("C" & N + 20).value = pTmpDt(6)

                oSheet.Range("C" & N + 20 & ":D" & N + 20).Merge    '셀병합

                oSheet.Range("E" & N + 20).value = pTmpDt(7)

                oSheet.Range("E" & N + 20 & ":H" & N + 20).Merge

            ElseIf pType = "B" Or pType = "B1" Then

                oSheet.Range("A" & N + 20).value = pTmpDt(1)

                oSheet.Range("B" & N + 20).value = pTmpDt(3)

                oSheet.Range("C" & N + 20).value = pTmpDt(5)

                oSheet.Range("D" & N + 20).value = pTmpDt(6)

                oSheet.Range("D" & N + 20 & ":E" & N + 20).Merge

                oSheet.Range("F" & N + 20).value = pTmpDt(7)

                oSheet.Range("F" & N + 20 & ":H" & N + 20).Merge

            ElseIf pType = "C" Or pType = "C1" Then

                oSheet.Range("A" & N + 20).value = pTmpDt(1)

                oSheet.Range("B" & N + 20).value = pTmpDt(3)

                oSheet.Range("C" & N + 20).value = pTmpDt(4)

                oSheet.Range("D" & N + 20).value = pTmpDt(5)

                oSheet.Range("E" & N + 20).value = pTmpDt(6)

                oSheet.Range("E" & N + 20 & ":F" & N + 20).Merge

                oSheet.Range("G" & N + 20).value = pTmpDt(7)

                oSheet.Range("G" & N + 20 & ":H" & N + 20).Merge

            End If

            oSheet.Range("I" & N + 20).value = pTmpDt(8)

            oSheet.Range("J" & N + 20).value = pTmpDt(9)

            oSheet.Range("K" & N + 20).value = pTmpDt(10)

            oSheet.Range("I19").value = Label2.Caption

            oSheet.Range("J19").value = "'$ " & Label3.Caption

        Next

        If Len(pType) = 2 Then

            oExcel.ActiveSheet.Rows("21:" & pCnt + 20).RowHeight = 35

            oExcel.ActiveSheet.Rows("21:" & pCnt + 20).Font.Size = 9

            For N = 1 To pCnt

                For M = 1 To 11

                    oSheet.Cells(N + 20, M).Borders.LineStyle = xlContinuous '셀 윤곽선(테두리 그리기)

                   'Borders를 그대로 사용하면 전체 윤곽선 그리기 .Borders() 해서 괄호안에 숫자를 넣으면 원하는 곳에만 테두리를 그릴 수 있음.

                Next

            Next

            oSheet.Range("I" & pCnt + 21).value = Label2.Caption

            oSheet.Range("K" & pCnt + 21).value = Label3.Caption

        End If

    End With

 

    oBook.SaveAs gSales.tSInvoice & ".xls"               '다른이름으로 저장하기

    pTxt = "저장되었습니다.  "

    Call gMsgBox(Me, pTxt, "저장완료", 1000, 1)        

    oExcel.Quit

 

 

 

End Sub