返回列表 上一主題 發帖

[發問] 核取方塊回存 (不連續)

兩者皆可
  1. Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = 1 Then
  8.                 Rng.Offset(, 0) = E.TopLeftCell.Offset(, 1).Value
  9.                 Rng.Offset(, 1) = E.TopLeftCell.Offset(, 2).Value
  10.                 Rng.Offset(, 2) = E.TopLeftCell.Offset(, 5).Value
  11.                 Rng.Offset(, 3) = E.TopLeftCell.Offset(, 7).Value
  12.                 Set Rng = Rng.Offset(1)
  13.             End If
  14.         End If
  15.     Next
  16. End Sub
複製代碼
  1. Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = 1 Then
  8.                 With E.TopLeftCell
  9.                     Rng.Resize(, 4) = Array(.Offset(, 1).Value, .Offset(, 2).Value, .Offset(, 5).Value, .Offset(, 7).Value)
  10.                 End With
  11.                 Set Rng = Rng.Offset(1)
  12.             End If
  13.         End If
  14.     Next
  15. End Sub
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

回復 3# kai6929

這個樣子?
          If E.OLEFormat.Object.Value = True Then
  1.     Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = True Then
  8.                 Rng.Offset(, 0) = E.TopLeftCell.Offset(, 1).Value
  9.                 Rng.Offset(, 1) = E.TopLeftCell.Offset(, 2).Value
  10.                 Rng.Offset(, 2) = E.TopLeftCell.Offset(, 5).Value
  11.                 Rng.Offset(, 3) = E.TopLeftCell.Offset(, 7).Value
  12.                 Set Rng = Rng.Offset(1)
  13.             End If
  14.         End If
  15.     Next
  16. End Sub
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

        靜思自在 : 不要小看自己,因為人有無限的可能。
返回列表 上一主題