宏Excel:输入框以键入行和列

时间:2017-03-22 01:34:28

标签: excel vba excel-vba

我有一个编码,可以帮助我选择我想要的范围。但我现在需要的是在输入框中键入特定数量的行和列,然后选择范围。例如,我需要5行和4列。我希望能够将5 x 4键入输入框。

我的代码:

Sub InsertShape()

  Dim Rng As Range
  Dim Shp4 As Shape

  Set Rng = Application.InputBox("Please Select Range", Type:=8)
  With Rng
  Set Shp4 = ActiveSheet.Shapes.AddShape(1, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
  If Rng Is Nothing Then
    MsgBox "Operation Cancelled"
  Else
    Rng.Select
    Shp4.Fill.Visible = msoFalse
  End If

  With Shp4.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
  End With

  Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
  Selection.Borders(xlInsideVertical).LineStyle = xlContinuous

  End With  
  End Sub

3 个答案:

答案 0 :(得分:2)

这个怎么样:

Sub InsertShape2()

    Dim my_row As Integer
    Dim my_col As Integer
    Dim Rng As Range

    my_row = InputBox("How many rows?", Default:=0)
    my_col = InputBox("How many columns?", Default:=0)
    If my_row = 0 Or my_col = 0 Then
        MsgBox "Operation Cancelled"
    Else
        Set Rng = ActiveSheet.Range(ActiveCell, ActiveCell.Offset(my_row - 1, my_col - 1))
        Rng.Select
        ' and do the rest of your shape stuff here
    End If

End Sub

答案 1 :(得分:2)

在你的问题中你说:

  

例如,我需要5行4列。我希望能够将5 x 4键入输入框。

如果您希望用户能够输入5x4之类的字符串,则需要将InputBox的{​​{3}}设置为2.然后您可以在{{ 1}}并使用当前用户选择的单元格,x使用Resize两侧的数字。以下示例x

如果你想在InsertShapeRxC中使用Type为8,那么用户需要输入一个真实的范围,例如G10:J15等。然后,您可以插入形状并对其进行格式化等。但如果您的InputBox为8并且输入Type则会出错。以下示例5x4

InsertShapeWithRange

答案 2 :(得分:2)

这应该按照你记住的方式完成工作。

Sub SelectRange()
    ' 22 Mar 2017

    Dim Rng As Range
    Dim Specs As String
    Dim Splt() As String
    Dim R As Long, C As Long
    Dim Done As Boolean

    Set Rng = ActiveSheet.Cells(1, 1)                   ' = A1
    Do While Not Done
        Specs = InputBox("Enter R x C")
        If Len(Specs) Then
            If InStr(1, Specs, "x", vbTextCompare) Then
                Do While InStr(1, Specs, "xx", vbTextCompare)
                    Specs = Replace(Specs, "xx", "x", Compare:=vbTextCompare)
                Loop
                Splt = Split(Specs, "x")
                R = CLng(Val(Splt(0)))
                C = CLng(Val(Splt(1)))
                If R < 1 Or C < 1 Then
                    MsgBox "Row and column numbers can't" & vbCr & _
                           "be smaller than 1.", vbCritical, _
                           "Invalid row or column number"
                Else
                    Rng.Resize(R, C).Select
                    Done = True
                End If
            Else
                MsgBox "Invalid entry without ""x""", vbInformation
            End If
        Else
            Exit Do
        End If
    Loop
End Sub