l 양식을 사용하여 데이터를 저장하십시오.

Question

모두에게 좋은 날 !!

나는 컨택 센터를 관리하고 일부 데이터를 캡처 할 직원을 필요로이 액세스 양식을 통해 쉽게 할 봤는데 수

생산성 계산하지만, 팀 인해 일부 정책

에 액세스 할 수 없습니다

요원이 매번 정보를 입력 한 다음 "제출"버튼을 클릭하면 데이터 입력 (드롭 다운 및 일부 무료 텍스트)을 위해 몇 가지 미리 정의 된 필드를 생성할지 알고 싶습니다.

"제출"버튼을 클릭하면 데이터가 ACCESS 테이블로 전달되고 Excel 필드가 공백으로 재설정됩니다.

참고 : 각 에이전트에는 공유 드라이브에 이름이 저장된 Excel 파일이 있습니다. ACCESS는 공유 드라이브에도 저장됩니다. 경로는 사전 정의되고 고정되어 있습니다.

는 아무도 내가이 전에 어딘가에 게시되어 있습니다 확신이

도와 주시겠습니까,하지만 난 정확한 요구 사항을 찾을 수가 기운 다.

감사합니다.

Answer 1

그래야합니다. 통합 문서 이름을 복사, 붙여 넣기 및 조정합니다.

Option Explicit 

Sub UpdateLogWorksheet() 

    Dim historyWks As Worksheet 
    Dim inputWks As Worksheet 

    Dim wb1 As Worksheet 

    Dim nextRow As Long 
    Dim oCol As Long 

    Dim myRng As Range 
    Dim myCopy As String 
    Dim myCell As Range 

    'cells to copy from Input sheet - some contain formulas 
    myCopy = "D5,D7,D9,D11,D13" 

    Set inputWks = Worksheets("Input") 
    Set historyWks = Worksheets("PartsData") 

    Set wb1 = Workbooks("1.xls").Worksheets("PartsData") 'change Workbook 

    With inputWks 
     Set myRng = .Range(myCopy) 

     If Application.CountA(myRng) <> myRng.Cells.Count Then 
      MsgBox "Please fill in all the cells!" 
      Exit Sub 
     End If 
    End With 

    With wb1 
     nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
     With .Cells(nextRow, "A") 
      .Value = Now 
      .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
     End With 
     .Cells(nextRow, "B").Value = Application.UserName 
     oCol = 3 
     For Each myCell In myRng.Cells 
      .Cells(nextRow, oCol).Value = myCell.Value 
      oCol = oCol + 1 
     Next myCell 
    End With 

    'clear input cells that contain constants 
    With inputWks 
     On Error Resume Next 
     With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants) 
       .ClearContents 
       Application.GoTo .Cells(1) ', Scroll:=True 
     End With 
     On Error GoTo 0 
    End With 
End Sub 

편집 : 지금까지 무엇을

Option Explicit 

Sub UpdateLogWorksheet() 

Application.ScreenUpdating = False 

    Dim historyWks As Worksheet 
    Dim inputWks As Worksheet 
    Dim wb1 As Worksheet 

    Dim nextRow As Long 
    Dim oCol As Long 

    Dim wb_path As String 
    Dim myCopy As String 
    Dim wb_name As String 

    Dim myRng As Range 
    Dim myCell As Range 

    'cells to copy from Input sheet - some contain formulas 
    myCopy = "D5,D7,D9,D11,D13" 
    wb_name = "1.xls" '2nd workbook name 
    wb_path = "C:\Reports\" & wb_name '2nd workbook path on HDD 

    Set inputWks = ThisWorkbook.Worksheets("Input") 'form sheet 
    Set historyWks = ThisWorkbook.Worksheets("PartsData") 'data in form sheet 

    Set myRng = inputWks.Range(myCopy) 

    If Application.CountA(myRng) <> myRng.Cells.Count Then 
     MsgBox "Please fill in all the cells!" 
     Exit Sub 
    End If 

    'if 2nd workbook file does not exists, message will pop up 
    If Dir(wb_path) = "" Then 
     MsgBox ("File does not exists") 
     Exit Sub: 

    'if exists it will open and become invisible 
    Else 
     Workbooks.Open Filename:=wb_path 
     Application.Windows(wb_name).Visible = False 
     Set wb1 = Workbooks(wb_name).Worksheets("PartsData") 'data in 2nd workbook 

     'copy data to 2nd workbook 
     With wb1 
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
      With .Cells(nextRow, "A") 
       .Value = Now 
       .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
      End With 
      .Cells(nextRow, "B").Value = Application.UserName 
      oCol = 3 
      For Each myCell In myRng.Cells 
       .Cells(nextRow, oCol).Value = myCell.Value 
       oCol = oCol + 1 
      Next myCell 
     End With 

     Application.Windows(wb_name).Visible = True 
     Workbooks(wb_name).Close True 

    End If 

    'copy data to form sheet 
    With historyWks 
     nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row 
     With .Cells(nextRow, "A") 
      .Value = Now 
      .NumberFormat = "mm/dd/yyyy hh:mm:ss" 
     End With 
     .Cells(nextRow, "B").Value = Application.UserName 
     oCol = 3 
     For Each myCell In myRng.Cells 
      .Cells(nextRow, oCol).Value = myCell.Value 
      oCol = oCol + 1 
     Next myCell 
    End With 


    'clear input cells that contain constants 
    With inputWks 
     On Error Resume Next 
     With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants) 
       .ClearContents 
       Application.GoTo .Cells(1) ', Scroll:=True 
     End With 
     On Error GoTo 0 
    End With 

Application.ScreenUpdating = True 

End Sub