Question

Excel2007 VBA程序的兼容性问题

Sheet1程序代码为：
Private Sub Worksheet_SelectionChange(ByValTarget As Range)
Arrow
End Sub
模块1当中程序代码为：
Sub Arrow() '使Sheet1内所有的箭头自动水平居中并（水平方向）填充满各自所在的单元格
Dim i As Integer
Dim Cell As Range
With ActiveSheet
For i = 1 To .Shapes.Count
If .Shapes(i).Name Like "直接箭头连接符*" Then
Set Cell =.Shapes(i).TopLeftCell
.Shapes(i).Width = Cell.Width
.Shapes(i).Height = 0
.Shapes(i).Top = Cell.Top +Cell.Height / 2
.Shapes(i).Left = Cell.Left
End If
Next
End With
End Sub

Sub bbb()’将已插入的矩形框自动居中并填充满（矩形框所在的）单元格
Dim sh As Shape
Dim rng As Range
Dim x&, y&, a%, b%
ForEach sh In Shapes
sh.Select
x = Selection.Top
y = Selection.Left
For i = 100 To 1 Step -1
If Rows(i).Top <= x Then
a = i
Exit For
End If
Next i
For j = 256 To 1 Step -1
If Columns(j).Left <= y Then
b = j
Exit For
End If
Next j
Set rng = Cells(a, b)
With Selection
.Top = rng.Top
.Left = rng.Left
.Width = rng.Width
.Height = rng.Height
End With
Next
End Sub
我试过了程序bbb只能放在Sheet1的VBA内使用，而不能放到模块1当中使用，放到模块2当中也不能用。不知道应该如何让程序Arrow 和bbb才能一起使用（自动执行）？

Answer 1

Sub bbb()’将已插入的矩形框自动居中并填充满（矩形框所在的）单元格
  Dim sh As Shape
  Dim rng As Range
  Dim x&, y&, a%, b%
With ActiveSheet
For Each sh  In .Shapes
sh.Select
x = Selection.Top
y = Selection.Left
For i = 100 To 1 Step -1
   If .Rows(i).Top <= x Then
      a = i
      Exit For
   End If
Next i
For j = 256 To 1 Step -1
   If .Columns(j).Left <= y Then
      b = j
      Exit For
   End If
Next j
Set rng = .Cells(a, b)
End With
With Selection
    .Top = rng.Top
    .Left = rng.Left
    .Width = rng.Width
    .Height = rng.Height
End With
Next
End Sub

模块中插入上面的程序试试

追问

程序提示我：“End With没有 With”就是倒数第九句（即第23行）

追答

Sub bbb()’将已插入的矩形框自动居中并填充满（矩形框所在的）单元格
  Dim sh As Shape
  Dim rng As Range
  Dim x&, y&, a%, b%
With ActiveSheet
For Each sh  In .Shapes
sh.Select
x = Selection.Top
y = Selection.Left
For i = 100 To 1 Step -1
   If .Rows(i).Top <= x Then
      a = i
      Exit For
   End If
Next i
For j = 256 To 1 Step -1
   If .Columns(j).Left <= y Then
      b = j
      Exit For
   End If
Next j
Set rng = .Cells(a, b)
With Selection
    .Top = rng.Top
    .Left = rng.Left
    .Width = rng.Width
    .Height = rng.Height
End With
Next
End With
End Sub

追问

我把这个程序放到了模块1内，用Sheet1内的程序自动调用并执行Arrow 和bbb程序，出现的结果是所有的箭头会从当前所在列自动跳到了前一列的单元格内，连续执行几次会发生所有的箭头方向紊乱（要求所有的箭头方向一致向右），而且程序在执行的时候时间较长，这样会影响工作的效率，还能再改进一下吗？