生成新的工作簿

熊文来

谢谢走过的大师，帮忙看看。


需求：
1、增加一个按钮：请根据模板样式，把数据源按照班级生成工作表，依次放在模板后面。生成的新工作表并保留模板的格式。

2、增加一个按钮：打印刚刚生成的每个班的工作表或者在第一个按钮里生成工作表后打印打印也可以。

3、增加一个按钮：请根据模板样式，把数据源按照班级生成独立的工作簿。生成的新工作表并保留模板的格式。

熊文来

自己顶一下。

ykcbf1100

嗯，以前帮过你了。

熊文来

ykcbf1100 发表于 2022-10-31 11:26
嗯，以前帮过你了。

是的 需求不一样，可以再看看这个文件吗？谢谢！

ykcbf1100

熊文来 发表于 2022-10-31 12:34
是的 需求不一样，可以再看看这个文件吗？谢谢！

你免费的小花都不愿意送，再帮你，说不过去啊。

Sean_zhang810

ykcbf1100 发表于 2022-10-31 12:36
你免费的小花都不愿意送，再帮你，说不过去啊。

哈哈，我送你两朵。

熊文来

ykcbf1100 发表于 2022-10-31 12:36
你免费的小花都不愿意送，再帮你，说不过去啊。

那是我的过错，可能看到文件就去使用了。忘记了！不好意思！以后保证每次都送。

ykcbf1100

Sean_zhang810 发表于 2022-10-31 12:52
哈哈，我送你两朵。

谢谢了啊。

wengjl

Sub 生成班级的表()
    '
    x2 = 2
    Do While Not (IsEmpty(Sheet2.Cells(x2, 1).Value))
      njm = Sheet2.Cells(x2, 1).Value
      bjm = Sheet2.Cells(x2, 2).Value
      bmc = Sheet2.Cells(x2, 1).Value & "年级" & Sheet2.Cells(x2, 2).Value & "班"
      bzr = Sheet2.Cells(x2, 3).Value
      For i = 1 To Worksheets.Count            ' 按工作表数量循环
        If Worksheets(i).Name = bmc Then       ' 通过循环判断，来完成指定表名是否存在的查找
          Application.DisplayAlerts = False    ' 此句的作用：删除表时不出现“是否删除的对话框”，相当于VF中设置了 SET SAFETY OFF
          Worksheets(i).Delete      ' 删除表
          'foun = True              ' 找到了变量为真，并退出查找
          Exit For
        End If
      Next i
      Sheets.Add.Name = bmc         ' 增加表，并起名为 BMC 变量中的值
      Sheets(bmc).Move after:=Sheets(Sheets.Count)     ' 将刚新增的表移动到最右侧
      '---先准备好空表，以备粘贴用
      Sheet3.Select
      Cells.Copy
      Sheets(bmc).Select
      ActiveSheet.Paste     ' 完成空的模板表准备
      Sheets(bmc).Cells(1, 1).Value = "某某学校 " & njm & " 年级 " & bjm & " 班学生体温监测表"
      Sheets(bmc).Cells(2, 3).Value = Date
      Sheets(bmc).Cells(2, 9).Value = bzr
      Sheets(bmc).Cells(33, 8).Value = bzr
      i = 1
      x1 = 2
      Do While Not (IsEmpty(Sheet1.Cells(x1, 1).Value))
        If Sheet1.Cells(x1, 1).Value = njm And Sheet1.Cells(x1, 2).Value = bjm Then
          If i < 31 Then
            Sheets(bmc).Cells(i + 3, 2).Value = Sheet1.Cells(x1, 4).Value
            i = i + 1
          Else
            Sheets(bmc).Cells(i - 27, 8).Value = Sheet1.Cells(x1, 4).Value
            i = i + 1
          End If
        End If
        x1 = x1 + 1
      Loop
      
      x2 = x2 + 1
    Loop
    Application.DisplayAlerts = True
   
End Sub

wengjl