Snasui Excel Forum

Code: Select all

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "update", , False
End Sub

Code: Select all

Private Sub CommandButton1_Click()
    If ComboBox1.Text = "" Then Exit Sub
    CommandButton1.Enabled = False
    startTime = Now()
    ActiveSheet.Range(Cells(1, 1), Cells(200, 1)).Clear
    continueTime = True
    row = 1
    If ComboBox1.ListIndex = 0 Then
        AddTime = TimeValue("0:00:01")
    ElseIf ComboBox1.ListIndex = 1 Then
        AddTime = TimeValue("0:00:02")
    ElseIf ComboBox1.ListIndex = 2 Then
        AddTime = TimeValue("0:00:03")
    ElseIf ComboBox1.ListIndex = 3 Then
        AddTime = TimeValue("0:00:04")
    ElseIf ComboBox1.ListIndex = 4 Then
        AddTime = TimeValue("0:00:05")
    ElseIf ComboBox1.ListIndex = 5 Then
        AddTime = TimeValue("0:00:06")
    End If
    update0
End Sub

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long
Public nextTime As Date
Public startTime As Date
Public AddTime As Date

Sub update0()
    On Error Resume Next
    If continueTime Then
        nextTime = Now() + AddTime
        ActiveSheet.Cells(row, 1).Select
        Cells(row, 1).Value = Format$(Now() - startTime, "hh:nn:ss")
            row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub

Code: Select all

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "update0", , False
End Sub

Code: Select all

Private Sub CommandButton1_Click()
    If ComboBox1.Text = "" Then Exit Sub
    CommandButton1.Enabled = False
    startTime = Now()
    startTime1 = Now()
    ActiveSheet.Range(Cells(1, 1), Cells(200, 1)).Clear
    continueTime = True
    row = 1
    If ComboBox1.ListIndex = 0 Then
        AddTime = TimeValue("00:00:01")
    ElseIf ComboBox1.ListIndex = 1 Then
        AddTime = TimeValue("00:00:02")
    ElseIf ComboBox1.ListIndex = 2 Then
        AddTime = TimeValue("00:00:03")
    ElseIf ComboBox1.ListIndex = 3 Then
        AddTime = TimeValue("00:00:04")
    ElseIf ComboBox1.ListIndex = 4 Then
        AddTime = TimeValue("00:00:05")
    ElseIf ComboBox1.ListIndex = 5 Then
        AddTime = TimeValue("00:00:06")
    End If
    Update0
    UpdateTime
End Sub

Private Sub CommandButton2_Click()
    On Error Resume Next
    CommandButton1.Enabled = True
    continueTime = False
    Application.OnTime nextTime, "Update0", , False
    Application.OnTime nextTime1, "UpdateTime", , False
End Sub

Private Sub CommandButton3_Click()
   Unload Me
End Sub

Private Sub UserForm_Activate()
    With UserForm1.ComboBox1
        .AddItem "1 sec", 0
        .AddItem "2 sec", 1
        .AddItem "3 sec", 2
        .AddItem "4 sec", 3
        .AddItem "5 sec", 4
        .AddItem "6 sec", 5
    End With
End Sub

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long
Public nextTime As Date
Public nextTime1 As Date
Public startTime As Date
Public startTime1 As Date
Public AddTime As Date

Sub Update0()
    On Error Resume Next
    If continueTime Then
        nextTime = Now() + AddTime
        ActiveSheet.Cells(row, 1).Select
        Cells(row, 1).Value = Format$(Now() - startTime, "hh:nn:ss")
        row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub

Sub UpdateTime()
    On Error Resume Next
    If continueTime Then
        nextTime1 = Now() + TimeValue("00:00:01")
        UserForm1.TextBox1.Text = Format$(Now() - startTime1, "hh:nn:ss")
        Application.OnTime nextTime1, "UpdateTime"
    End If
End Sub

Code: Select all

sheet PowerEx    
id	name	description	type	        value	       unit	      time	                staus
1	11CG	gas 01	     analog  	0.153381591	MW	4/4/2014 20:16	Good
2	12CG	gas 02	     analog	        0.823648765	MW	4/4/2014 20:17	Good

**คอลัม value ข้อมูลจะเเรมด้อม

sheet sheet1
         A                         B
11CG                        12CG
0.153381591            0.823648765
x  5 sec ผ่านไป             y  5 sec ผ่านไป
x  5 sec ผ่านไป             y  5  sec ผ่านไป
x  5 sec ผ่านไป             y  5 sec ผ่านไป

ประมาณนี้ครับคือสามารถเพิ่มข้อมูลใน sheet Powerex ได้ตลอดเเล้วสามารถเก็บข้อมูลลจากsheet Powerex  ลงใน sheet1 ได้ เเล้วทำตามรูปแบบตัวอย่างและสร้างกราฟเส้นดูค่าเปลี่ยนแปลงได้ใน sheet1 ได้ครับ

Code: Select all

Option Explicit

Public continueTime As Boolean
Public row As Long, ws1 As Long, wsPx As Long
Public column As Long
Public nextTime As Date
Public startTime As Date
Public AddTime As Date


Sub Update0()
    On Error Resume Next
    If continueTime Then
                nextTime = Now() + AddTime
        Do Until Selection.Value = ""
              Application.Calculate
              ws1.Value = Worksheets("Sheet1").Cells(row + 1, 1).End(xlUp).Offset(1, 0).Select
              wsPx.Value = Worksheets("PowerEx").Range("E" & Cells(row + 1, 5)).End(xlUp).Offset(1, 0).Select
              ws1.Value = wsPx.Value
        Loop
           row = row + 1
        Application.OnTime nextTime, "Update0"
    End If
End Sub


Sub UpdateTime()

    On Error Resume Next
    If continueTime Then

        nextTime = Now() + TimeValue("00:00:01")

        UserForm1.TextBox1.Text = Format$(Now() - startTime, "hh:nn:ss")
        Application.OnTime nextTime, "UpdateTime"

    End If

End Sub

Code: Select all

Dim row1 As Long
Sub CopyAuto()

    
    row1 = 1
    Do Until Selection.Value = "" 
          Worksheets("PowerEx").Select
          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
          Selection.Copy
          Worksheets("Sheet1").Select
           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
          ActiveSheet.Paste
           row1 = row1 + 1
           Application.CutCopyMode = False
      Loop
      Application.OnTime nextTime, "CopyAuto"
End Sub

Code: Select all

Private Sub CommandButton4_Click()
       Worksheets("Sheet1").Range("A" & Cells(Rows.Count, 1).End(xlUp).row + 1).Select
       ActiveSheet.Shapes.AddChart.Select
       ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$B$100")
      ActiveChart.ChartType = xlLineMarkers
End Sub

Code: Select all

 
Do Until Selection.Value = ""
              Application.Calculate
              ws1.Value = Worksheets("Sheet1").Cells(row + 1, 1).End(xlUp).Offset(1, 0).Select
              wsPx.Value = Worksheets("PowerEx").Range("E" & Cells(row + 1, 5)).End(xlUp).Offset(1, 0).Select
              ws1.Value = wsPx.Value
Loop

Code: Select all

Do Until Selection.Value = "" 
          Worksheets("PowerEx").Select
          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
          Selection.Copy
          Worksheets("Sheet1").Select
           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
          ActiveSheet.Paste
           row1 = row1 + 1
           Application.CutCopyMode = False
      Loop

Code: Select all

Dim h As Boolean

Sub CopyAuto()

' กำหนดคัดลอกวางออโต้ชื่อของเส้น
    If h = False Then
        Worksheets("PowerEx").Select
        Range("b2", Range("b" & Rows.Count).End(xlUp)).Copy
        Worksheets("Sheet1").Range("a1").PasteSpecial xlPasteValues, _
            Transpose:=True
        h = True
    End If
    Worksheets("PowerEx").Select
    Range("e2", Range("e" & Rows.Count).End(xlUp)).Copy
    Worksheets("Sheet1").Range("a" & Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues, Transpose:=True
    Application.CutCopyMode = False

'    row1 = 1 'row1 เก็บค่า1 ไว้
'    Do Until Selection.Value = ""  'สั่งให้ทวนจนกว่าจะเจอช่องว่าง
'          Range(Cells(row1, 2), Cells(row1, 2)).End(xlUp).Offset(1, 0).Select
'          Selection.Copy
'          Worksheets("Sheet1").Select
'           Range(Cells(row1, 2), Cells(row1, 2)).End(xlToRight).Offset(0, 1).Select
'          ActiveSheet.Paste
'           row1 = row1 + 1
'           Application.CutCopyMode = False
'      Loop
      Application.OnTime nextTime, "CopyAuto"
End Sub

Code: Select all

Sub MarkGraph()
'สร้างกราฟ
    On Error Resume Next
     Worksheets("Sheet1").Range("A" & Cells(Rows.Count, 1).End(xlUp).row + 1).Select
      ActiveSheet.Shapes.AddChart.Select
      ActiveChart.ChartType = xlLine   ' เปลี่ยนกราฟเส้น
      ActiveChart.SetSourceData Source:=Range("$A$1").Select
      Selection.End(xlUp).Select
      Selection.End(xlToLeft).Select
      Range(Selection, Selection.End(xlToRight)).Select
      Range(Selection, Selection.End(xlDown)).Select
'      ActiveChart.ChartType = xlLine      วางตรงนี้เเล้วเปลี่ยนการเป็นกราฟเส้นไม่ได้
End Sub

Code: Select all

Sub MarkGraph()
'สร้างกราฟ
    With Sheets("Sheet1")
        .Range("A1").CurrentRegion.Activate
        .Shapes.AddChart.Select
        With ActiveChart
            .ChartType = xlLine
            .SetSourceData Range("a1").CurrentRegion, PlotBy:=xlColumns
        End With
    End With
End Sub