주소록 만들기(viewlist)

invalid-file

[form1]
Option Explicit
Public i As Integer
Public gsSaveFileName As String

Private Sub Command1_Click() '추가 클릭시 이벤트
    Form2.Show
    Form2.Caption = "정보 추가"
End Sub

Private Sub Command4_Click() 'listview 초기화
   
    Dim a(), b(), c(), d(), e(), f() As String
       
        For i = 1 To ListView1.ListItems.Count
            ListView1.ListItems(i).SubItems(1) = ""
            ListView1.ListItems(i).SubItems(2) = ""
            ListView1.ListItems(i).SubItems(3) = ""
            ListView1.ListItems(i).SubItems(4) = ""
            ListView1.ListItems(i).SubItems(5) = ""
            ListView1.ListItems(i).SubItems(6) = ""
        Next i
    
End Sub

Private Sub Command5_Click() '선택삭제
    ListView1.ListItems.Remove ListView1.SelectedItem.Index
End Sub

Private Sub Command6_Click() '정보수정 form2로 이동
    Form2.Show
    Form2.Caption = "정보 수정"
End Sub

Private Sub ListView1_LostFocus()
   ' 컨트롤이 포커스를 잃은 후 각 ListItem의 선택된
   ' 속성을 False로 다시 설정합니다.
   Dim i As Integer
   For i = 1 To ListView1.ListItems.Count
      ListView1.ListItems.Item(i).Selected = False
   Next i
End Sub

Private Sub Command7_Click()
   
    Dim j, i As Integer
    Dim itmFound As ListItem
   
    Call ListView1_LostFocus
    For j = 1 To 6
        For i = 1 To ListView1.ListItems.Count
                 If ListView1.ListItems(i).SubItems(j) = Text1.Text Then
                    Set itmFound = ListView1.FindItem(i)
                    itmFound.EnsureVisible '찾는행으로 스크롤 옮김.
                    itmFound.Selected = True
                    ListView1.SetFocus      '포커스를 줌
   
                End If
        Next i
    Next j
   
    If itmFound Is Nothing Then  ' 찾는거 없다 -> 알려주고 끝냄.
        MsgBox "일치하는 정보가 없습니다."
        Text1.SetFocus
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1.Text)
        Exit Sub
    End If
  
  
'    Dim strFindMe As String
'    Dim itmFound As ListItem   ' FoundItem 변수.
'
'    Call ListView1_LostFocus
'
'
'    Set itmFound = ListView1.FindItem(Text1.Text, lvwSubItem, , lvwPartial)
'    'lvwSubItem 자리에 들어갈 수 있는거는
'    'lvwSubItem 또는 lvwText 또는 lvwTag 가 있음. MSDN 참고
'    '마지막자리에 lvwPartial : Like % 검색...첫 번에 나온거에 멈춤.
'    'lvwWholeWord : 정확하게 맞는거 검색.
'
'    If itmFound Is Nothing Then  ' 찾는거 없다 -> 알려주고 끝냄.
'      MsgBox "일치하는 정보가 없습니다."
'      Exit Sub
'
'    Else
'       itmFound.EnsureVisible '찾는행으로 스크롤 옮김.
'       itmFound.Selected = True   ' 찾은행을 선택함.
'       ListView1.SetFocus      '포커스를 줌
'    End If

End Sub

Private Sub Form_Load() '컬럼 정의
    Dim COL(6) As ColumnHeader
    Set COL(0) = ListView1.ColumnHeaders.Add(, , " ", 0)
    Set COL(1) = ListView1.ColumnHeaders.Add(, , "학번", 1000)
    Set COL(2) = ListView1.ColumnHeaders.Add(, , "성명", 1000)
    Set COL(3) = ListView1.ColumnHeaders.Add(, , "영어", 700)
    Set COL(4) = ListView1.ColumnHeaders.Add(, , "국어", 700)
    Set COL(5) = ListView1.ColumnHeaders.Add(, , "수학", 700)
    Set COL(6) = ListView1.ColumnHeaders.Add(, , "평균", 700)

End Sub

Private Sub Command2_Click()
'커먼다이얼로그에 지정된 경로로 입시정보목록을 저장하는 소스

    On Error Resume Next

    Dim a(), b(), c(), d(), e(), f() As String
    com.Filter = "텍스트파일 (*.txt)|*.txt"
    com.ShowSave

    For i = 1 To ListView1.ListItems.Count

        ReDim Preserve a(i), b(i), c(i), d(i), e(i), f(i)
        '변수 a(i)와 b(i), c(i), d(i), e(i)를 선언함.

         a(i) = ListView1.ListItems(i).SubItems(1)
         b(i) = ListView1.ListItems(i).SubItems(2)
         c(i) = ListView1.ListItems(i).SubItems(3)
         d(i) = ListView1.ListItems(i).SubItems(4)
         e(i) = ListView1.ListItems(i).SubItems(5)
         f(i) = ListView1.ListItems(i).SubItems(6)
        
    Next i
' 리스트뷰에 입력되어 있는 내용을 각각 변수 a(i)와 b(i), c(i), d(i), e(i)에 대입 시킴.

    Open com.filename For Output As 1
        For i = 1 To ListView1.ListItems.Count
            Write #1, a(i), b(i), c(i), d(i), e(i), f(i)
        Next i
    Close #1
      ' 위의 경로에 변수 a(i)와 b(i), c(i), d(i), e(i)에 대입된 내용을 저장함.
     
End Sub

Private Sub Command3_Click()
''커먼다이얼로그에 지정된 경로에서 입시정보목록을 불러오는 소스

    On Error GoTo er
    Dim itm As ListItem       ' 변수 itm을 ListItem형으로 선언함.
    Dim a, b, c, d, e, f As String
   
    com.Filter = "텍스트파일 (*.txt)|*.txt"
    com.ShowOpen
    ListView1.ListItems.Clear

    Open com.filename For Input As #1
        Do Until EOF(1) ' 위의 경로에 있는 내용을
            Input #1, a, b, c, d, e, f ' 변수 a와b, c, d, e 에 대입해서
                Set itm = ListView1.ListItems.Add()
                itm.SubItems(1) = a
                itm.SubItems(2) = b
                itm.SubItems(3) = c
                itm.SubItems(4) = d
                itm.SubItems(5) = e
                itm.SubItems(6) = f
        Loop            ' ListView1에 입력함.
    Close #1

    For i = 1 To ListView1.ListItems.Count
       Set itm = ListView1.ListItems(i)
           itm.Text = i
    Next i
    Me.Caption = Left(com.FileTitle, Len(com.FileTitle) - 4)
Exit Sub
er:
End Sub

Private Sub ListView1_DblClick() 'listview 더블클릭시 수정
    Command6_Click
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) '컬럼정렬
    If ListView1.SortOrder = 0 Then
        ListView1.SortOrder = 1
        ListView1.SortKey = ColumnHeader.Index - 1
    Else
        ListView1.SortOrder = 0
    End If
    ListView1.Sorted = True
End Sub

Private Sub openExcel_Click()
    Dim objExcel As Excel.Application
    Dim ObjWorksheet As Excel.Worksheet
    Dim xlWorkbook As Excel.Workbook
    Dim filename As String
    Dim i As Integer
    Dim itm As ListItem
   
    ListView1.ListItems.Clear
   
    com.CancelError = True
    com.Flags = cdlOFNHideReadOnly
    com.Filter = "Excel Files (*.xls)|*.xls"
    com.FilterIndex = 2
    com.ShowOpen
    filename = com.filename
   
    Set objExcel = CreateObject("Excel.Application")
    Set xlWorkbook = objExcel.Workbooks.Open(filename, ReadOnly:=True)
    Set ObjWorksheet = xlWorkbook.Worksheets("성적")
    objExcel.Visible = False
   
    i = 1
            Do While Not ObjWorksheet.Cells(i + 1, 1) = ""
           
                Set itm = ListView1.ListItems.Add()
                itm.SubItems(1) = ObjWorksheet.Cells(i + 1, 1)
                itm.SubItems(2) = ObjWorksheet.Cells(i + 1, 2)
                itm.SubItems(3) = ObjWorksheet.Cells(i + 1, 3)
                itm.SubItems(4) = ObjWorksheet.Cells(i + 1, 4)
                itm.SubItems(5) = ObjWorksheet.Cells(i + 1, 5)
                itm.SubItems(6) = ObjWorksheet.Cells(i + 1, 6)
            i = i + 1
            Loop
   
    Me.Caption = Left(com.FileTitle, Len(com.FileTitle) - 4)
           
    Set objExcel = Nothing
    Set ObjWorksheet = Nothing
    Set xlWorkbook = Nothing
   

   
End Sub

Private Sub saveExcel_Click() '엑셀 저장
    On Error GoTo er
    Dim objExcel As Excel.Application
    Dim objWorkbook As Excel.Workbook
    Dim ObjWorksheet As Excel.Worksheet
    Dim idx As Integer
    Dim filename As String
   
    com.CancelError = True
    '플래그를 설정합니다.(읽기전용)
    com.Flags = cdlOFNHideReadOnly
    '필터를 설정합니다.
    com.Filter = "Excel Files (*.xls)|*.xls"
    '기본 필터를 지정합니다.
    com.FilterIndex = 2
    '[다른 이름으로 저장] 대화 상자를 표시합니다.
    com.ShowSave
    '선택된 파일 이름을 표시합니다.
    filename = com.filename
 
   
   
    Set objExcel = CreateObject("excel.application")
    objExcel.Visible = False
     Set objWorkbook = objExcel.Workbooks.Add
    objExcel.DisplayAlerts = False
   
    Do While objWorkbook.Worksheets.Count > 1
        Set ObjWorksheet = objWorkbook.Worksheets.Item(objWorkbook.Worksheets.Count)
        ObjWorksheet.Delete
    Loop
   
    objWorkbook.Worksheets("sheet1").Activate
    Set ObjWorksheet = objWorkbook.ActiveSheet
    ObjWorksheet.Name = "성적"

    idx = 1
    '제목달기
   
    ObjWorksheet.Cells(idx, 1) = "학번"
    ObjWorksheet.Cells(idx, 2) = "성명"
    ObjWorksheet.Cells(idx, 3) = "영어"
    ObjWorksheet.Cells(idx, 4) = "국어"
    ObjWorksheet.Cells(idx, 5) = "수학"
    ObjWorksheet.Cells(idx, 6) = "평균"

    '칼럼포맷 설정
    ObjWorksheet.Rows(idx).Font.Bold = True
    ObjWorksheet.Rows(idx).HorizontalAlignment = 3

    idx = idx + 1
    ObjWorksheet.Cells.ColumnWidth = 12

    '셀에 데이터 쓰기
    For idx = idx To ListView1.ListItems.Count
        ObjWorksheet.Cells(idx, 1) = ListView1.ListItems(idx - 1).SubItems(1)
        ObjWorksheet.Cells(idx, 2) = ListView1.ListItems(idx - 1).SubItems(2)
        ObjWorksheet.Cells(idx, 3) = ListView1.ListItems(idx - 1).SubItems(3)
        ObjWorksheet.Cells(idx, 4) = ListView1.ListItems(idx - 1).SubItems(4)
        ObjWorksheet.Cells(idx, 5) = ListView1.ListItems(idx - 1).SubItems(5)
        ObjWorksheet.Cells(idx, 6) = ListView1.ListItems(idx - 1).SubItems(6)
    Next idx

    objExcel.ActiveWorkbook.SaveAs filename
    objExcel.ActiveWorkbook.Close
Exit Sub
er:
End Sub

Private Sub search_Click()
    Form4.Show
    Form4.Caption = "검색"
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Command7.Value = True
 End Sub

===========================================================================================================
[form2]
 Option Explicit
Public i As Integer
Private Sub text1_gotfocus() '텍스트 창에 커서 위치시에 글자길이만큼 블럭화
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub text2_gotfocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub text3_gotfocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.Text)
End Sub

Private Sub text4_gotfocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4.Text)
End Sub

Private Sub text5_gotfocus()
    Text5.SelStart = 0
    Text5.SelLength = Len(Text5.Text)
End Sub

Private Sub Command1_Click() '등록, 수정
    Dim itm As ListItem
             
      If Command1.Caption = "등록" Then
          Set itm = Form1.ListView1.ListItems.Add()
        itm.SubItems(1) = Text1
        itm.SubItems(2) = Text2
        itm.SubItems(3) = Text3
        itm.SubItems(4) = Text4
        itm.SubItems(5) = Text5
        itm.SubItems(6) = (Val(Text3.Text) + Val(Text4.Text) + Val(Text5.Text)) / 3
    Else
          Set itm = Form1.ListView1.ListItems.Add()
        itm.SubItems(1) = Text1
        itm.SubItems(2) = Text2
        itm.SubItems(3) = Text3
        itm.SubItems(4) = Text4
        itm.SubItems(5) = Text5
        itm.SubItems(6) = (Val(Text3.Text) + Val(Text4.Text) + Val(Text5.Text)) / 3
        Form1.ListView1.ListItems.Remove Form1.ListView1.SelectedItem.Index
   End If

    For i = 1 To Form1.ListView1.ListItems.Count
        Set itm = Form1.ListView1.ListItems(i)
        itm.Text = i
    Next i

    Unload Me

End Sub

Private Sub Command2_Click() '취소->창닫기
    Unload Me
End Sub

Private Sub Command3_Click() '초기화
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""

End Sub

Private Sub Form_Activate() 'form1에서 form2창 오픈시에 정보추가 caption이면 버튼caption을 등록으로
    If Me.Caption = "정보 추가" Then
        Command1.Caption = "등록"
    Else
        Command1.Caption = "수정"
        '수정할 입시정보 내용을 표시함
        Text1 = Form1.ListView1.SelectedItem.SubItems(1)
        Text2 = Form1.ListView1.SelectedItem.SubItems(2)
        Text3 = Form1.ListView1.SelectedItem.SubItems(3)
        Text4 = Form1.ListView1.SelectedItem.SubItems(4)
        Text5 = Form1.ListView1.SelectedItem.SubItems(5)
       
    End If
End Sub

===================================================================================================
[form4]
Option Explicit
Private Sub ListView1_LostFocus()
   ' 컨트롤이 포커스를 잃은 후 각 ListItem의 선택된
   ' 속성을 False로 다시 설정합니다.
   Dim i As Integer
   For i = 1 To Form1.ListView1.ListItems.Count
      Form1.ListView1.ListItems.Item(i).Selected = False
   Next i
End Sub

Private Sub Command1_Click()
    Dim strFindMe As String
    Dim itmFound As ListItem   ' FoundItem 변수.

    Call ListView1_LostFocus

    Set itmFound = Form1.ListView1.FindItem(Text1.Text, lvwSubItem, , lvwPartial)
    'lvwSubItem 자리에 들어갈 수 있는거는
    'lvwSubItem 또는 lvwText 또는 lvwTag 가 있음. MSDN 참고
    '마지막자리에 lvwPartial : Like % 검색...첫 번에 나온거에 멈춤.
    'lvwWholeWord : 정확하게 맞는거 검색.

    If itmFound Is Nothing Then  ' 찾는거 없다 -> 알려주고 끝냄.
      MsgBox "일치하는 정보가 없습니다."
      Text1.SetFocus
      Text1.SelStart = 0
      Text1.SelLength = Len(Text1.Text)
      Exit Sub

    Else
       itmFound.EnsureVisible '찾는행으로 스크롤 옮김.
       itmFound.Selected = True   ' 찾은행을 선택함.
       Form1.ListView1.SetFocus      '포커스를 줌
    End If
    Unload Me
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then Command1.Value = True
End Sub