Office中国论坛/Access中国论坛

标题: 請幫忙解決表格問題 [打印本页]

作者: joyark 时间: 2005-3-2 23:56
标题: 請幫忙解決表格問題
把握公司常用表格在菜單上自動生成

在A1單元名稱生成工作表名稱

各位高人指導及幫忙解決

[attach]9149[/attach]

[attach]9150[/attach]

Sub 物品价格表() '吧台出售物品价格表

Range("A1").Value = "吧台出售物品价格表" '文字位置

Range("A2").Value = "序号"

Range("B2").Value = "名称"

Range("C2").Value = "原价"

Range("D2").Value = "单位"

Range("E2").Value = "价格"

Range("F2").Value = "差价"

Range("G2").Value = "毛利率"

Range("H2").Value = "备注"

'---------------------------------------------------------------------------

Range("A3").Select '函數

ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",MAX(R[-1]C:R[-1]C)+1)"

Selection.Copy

Range("A3:A32").Select

ActiveSheet.Paste

Range("F3").Select '函數

ActiveCell.FormulaR1C1 = "=IF(OR(RC[-3]="""",),"""",SUM(RC[-1]-RC[-3]))"

Selection.Copy

Range("F3:F32").Select

ActiveSheet.Paste

Range("G3").Select '函數

ActiveCell.FormulaR1C1 = "=IF(OR(RC[-1]="""",),"""",SUM(RC[-1]C[-2]))"

Selection.Copy

Range("G3:G32").Select

ActiveSheet.Paste

'--------------------------------------------------------------------------

Range("A1").Select '字體

Selection.Font.ColorIndex = 3

With Selection.Font

      .Name = "宋体"

      .Size = 20

      .Strikethrough = False

      .Superscript = False

      .Subscript = False

      .OutlineFont = False

      .Shadow = False

      .Underline = xlUnderlineStyleNone

      .ColorIndex = 5

End With

'-----------------------------------------------------------------------------

Range("B3:B32").Select '下拉單

With Selection.Validation

      .Delete

      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

      xlBetween, Formula1:="咸干花生,鱿鱼丝,妙脆角,粟米脆,欢乐薯,烤鱼片,脆薯片,锅巴,怪味胡豆,夹心米果,喜之郎果冻,薛涛干,龙须牛肉,豆腐条,老川东牛肉干,遛洋狗牛肉干,手指饼,金帝巧克力,老城南牛肉粒,品客薯片,百草果,曼妥思,日式三文鱼,开心果,棒棒娃牛肉粒,清嘴含片,香香嘴豆腐干,煮土鸡蛋,甜粘玉米,火腿煎双蛋"

      .IgnoreBlank = True

      .InCellDropdown = True

      .InputTitle = ""

      .ErrorTitle = ""

      .InputMessage = ""

      .ErrorMessage = ""

      .IMEMode = xlIMEModeNoControl

      .ShowInput = True

      .ShowError = True

End With

   '-----------------------------------------------------------------------------

Range("D3

32").Select '下拉單

With Selection.Validation

      .Delete

      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

      xlBetween, Formula1:="包,个,根,套"

      .IgnoreBlank = True

      .InCellDropdown = True

      .InputTitle = ""

      .ErrorTitle = ""

      .InputMessage = ""

      .ErrorMessage = ""

      .IMEMode = xlIMEModeNoControl

      .ShowInput = True

      .ShowError = True

      '-----------------------------------------------------------------------------

End With

Range("A2,B2,C2,D2,E2,F2,G2,H2").Select '文字置中

With Selection

      .HorizontalAlignment = xlCenterAcrossSelection

      .VerticalAlignment = xlCenter

      .WrapText = False

      .Orientation = 0

      .AddIndent = False

      .IndentLevel = 0

      .ShrinkToFit = False

      .ReadingOrder = xlContext

      .MergeCells = False

End With

Range("A2:H2").Select

With Selection.Interior

      .ColorIndex = 15

      .Pattern = xlSolid

   End With

   '-----------------------------------------------------------------------------

Range("A1:H1").Select '合併

With Selection

      .HorizontalAlignment = xlCenterAcrossSelection

      .VerticalAlignment = xlCenter

      .WrapText = False

      .Orientation = 0

      .AddIndent = False

      .IndentLevel = 0

      .ShrinkToFit = False

      .ReadingOrder = xlContext

      .MergeCells = False

End With

   '-------------------------------------------------------------------

作者: 情比金坚 时间: 2005-3-3 02:16
为什么不用模板呢？

作者: 老鬼 时间: 2005-3-3 04:17
把菜单指定宏就可以了

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)