- 帖子
- 84
- 主題
- 24
- 精華
- 0
- 積分
- 118
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- offcie 2007
- 閱讀權限
- 20
- 註冊時間
- 2010-5-6
- 最後登錄
- 2024-2-17
|
大師好
此巨集為某大師幫忙完成之傑作,想在改成達到以下的功能是否可幫幫忙,
1.首先在Sheet1 底下輸入資料後按下
■加工一 C25:= 1 ■加工一 C26:= 1 ■加工一 C27:= 1
2.SHEET2 呈現結果如下 項次 L 13以下 自動產生
3.在Sheet1 底按下
□加工一 C25:= 0 □加工一 C26:= 0 □加工一 C27:= 0
4.SHEET2 呈現結果如下 項次 L13:S27以下 清除內容
Option Explicit
Sub check()
Dim K As String, M As Boolean, xRow As Integer, xi As Integer
With ActiveSheet.Shapes(Application.Caller)
With .TextFrame
K = .Characters.Text
If Left(K, 1) = "■" Then
.Characters.Text = "□加工一"
M = False
Else
.Characters.Text = "■加工一"
M = True
End If
.Characters(1, Len(K) + 1).Font.Size = 10
.Characters(1, 1).Font.Size = 10
End With
.TopLeftCell.Offset(, 1) = M
.TopLeftCell.Offset(, 2) = IIf(CSng(M) = 0, 0, 1)
End With
Sheet2.UsedRange("L13:S27").ClearContents
xRow = 25
With ActiveSheet
Do While .Cells(xRow, "C") <> ""
If .Cells(xRow, "C") = 1 Then
xi = xi + 1
Sheet2.Rows(1).Copy Sheet2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
With Sheet2.Cells(Rows.Count, "A").End(xlUp)
.Cells(1) = xi
.Cells(12, 14) = ActiveSheet.Cells(xRow, "F")
.Cells(12, 17) = ActiveSheet.Cells(xRow, "H")
.Cells(12, 18) = ActiveSheet.Cells(xRow, "J")
.Cells(12, 19) = ActiveSheet.Cells(xRow, "K")
End With
End If
xRow = xRow + 1
Loop
End With
End Sub
 kai~20.rar (72.82 KB)
|
-
1
評分人數
-
|
發表於 2012-11-2 11:38
| 
