使用VBA将X行放在Excel上进行屏幕显示

我目前正在编写一个Excel工作簿上的一个小VBA代码来自动显示日志。 所以我的工作簿里有两张 其中一个显示当前日志，按紧急情况sorting。 另一个显示给定部门的新日志。 工作簿连接到我们的日志数据库，并通过SQL数据库上的视图每5分钟刷新一次数据。 我的问题是，目前，我没有设置行高度以适应我的屏幕。 我需要确保行高度dynamic设置为始终显示相同数量的行。 例如，如果用户希望能够看到5行，我希望他能够（通过我创build的表单）。 然后我会用5行滚动。 所以这里是我的代码：

'Check how many "Urgent" Logs are showing Dim XRange As Range Set XRange = Cells(Rows.Count, 4).End(xlUp) Set XRange = Range(Range("C1"), XRange) AnswerUrgent = Application.CountIf(XRange, "Urgent") 'Check how many "High" Logs are showing Dim YRange As Range Set YRange = Cells(Rows.Count, 4).End(xlUp) Set YRange = Range(Range("C1"), YRange) AnswerHigh = Application.CountIf(YRange, "High") 'Check how many logs to show TotalAns = AnswerUrgent + AnswerHigh For X = 1 To (Round(TotalAns / 4) + 1) If X > 1 Then ActiveWindow.SmallScroll Down:=ScrollBy '(move down by 4 rows) End If 'Responsive sleep is to sleep and do events after each 250MS so the form will be 'accessible ' *4 to get 1 sec ResponsiveSleep (DelayInSec * 4) Next X 

我想要做的是使这个dynamic。 如果用户select5行显示，我希望能够显示5个，并滚动5。

我不想为整个表格调整比例。 我的意思是我不想使用缩放来获取整个表格，以适应我的屏幕。

谢谢！

Answer 1

我已经find了这样做的方式…我决定find一种方式去全屏（没有标题栏和一切），所以我可以使用以下内容：

 Sub FormatWindow(ScrollBy) Dim Xres As Integer Dim Yres As Integer Dim MaxXPoint As Single Dim MaxYpoint As Single Dim RowHeightForFour As Integer Xres = GetSystemMetrics(SM_CXSCREEN) Yres = GetSystemMetrics(SM_CYSCREEN) '1 pixel = 0.75 Point MaxXPoint = (Xres * 0.75) MaxYpoint = (Yres * 0.75) 'Set the first row to 5% of screen PointForFirstRow = ((MaxYpoint * 5) / 100) 'Get the rest of the space to display rows MaxPointAfterFirstRow = MaxYpoint - ((MaxYpoint * 5) / 100) 'Set the first row to take 5% of the total displayable Y resolution ActiveSheet.Rows(1).RowHeight = PointForFirstRow 'Get how many points per row PointPerRow = MaxPointAfterFirstRow / ScrollBy Dim ws As Worksheet For Each ws In Worksheets 'If the sheet's name is not "Start", Apply the Height to all the rows. If Not (ws.Name = "Start") Then ws.Range("A2:A" & ws.Rows.Count).RowHeight = PointPerRow End If Next ws End Sub 

希望这可以帮助别人！