macrosExcel：input框键入行和列
我有一个编码，可以帮助我select我想要的范围。 但我现在需要的是在input框中input特定数量的行和列，然后范围将被选中。 例如，我需要5行4列。 我希望能够在input框中键入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 在你的问题中你说：
例如，我需要5行4列。 我希望能够在input框中键入5 x 4。
如果您希望用户能够input像5x4这样的string，那么您需要将InputBox的Type设置为2.然后，您可以在x上分割并使用当前用户select的单元格，然后通过数字的任意一侧来Resize它的Resize x 。 以下示例在InsertShapeRxC 。
如果你想在InputBox使用Type 8，那么用户需要input一个真实的范围，比如G10：J15或者其他东西。 然后你可以插入形状和格式等，但如果你有8 Type ，他们进入5x4它会出错。 以下示例在InsertShapeWithRange 。
Option Explicit Sub InsertShapeRxC() Dim strInput As String Dim lngRows As Long, lngColumns As Long Dim rngShape As Range Dim ws As Worksheet Dim shp As Shape ' get user input as string strInput = Application.InputBox("Please enter RxC", Type:=2) ' get rows and columns from input - expected RxC lngRows = Split(strInput, "x", -1, vbTextCompare)(0) lngColumns = Split(strInput, "x", -1, vbTextCompare)(1) ' resize current selection to rows and columns as input Set rngShape = Selection Set rngShape = rngShape.Resize(lngRows, lngColumns) ' get reference to worksheet Set ws = rngShape.Parent ' add shape Set shp = ws.Shapes.AddShape(1, rngShape.Left, rngShape.Top, rngShape.Width, rngShape.Height) With shp .Fill.Visible = msoFalse With .Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 End With End With With rngShape .Borders(xlInsideHorizontal).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With End Sub Sub InsertShapeWithRange() Dim strInput As String Dim lngRows As Long, lngColumns As Long Dim rngShape As Range Dim ws As Worksheet Dim shp As Shape ' get user input as string Set rngShape = Application.InputBox("Please enter range", Type:=8) ' get reference to worksheet Set ws = rngShape.Parent ' add shape Set shp = ws.Shapes.AddShape(1, rngShape.Left, rngShape.Top, rngShape.Width, rngShape.Height) With shp .Fill.Visible = msoFalse With .Line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 End With End With With rngShape .Borders(xlInsideHorizontal).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous End With End Sub
这应该以你想到的方式来完成工作。
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
这个怎么样：
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