[[20181225101750]]　『PictureクラスのFormulaプロパティを設定できませ』（Charlie）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『PictureクラスのFormulaプロパティを設定できません』（Charlie）

以下のマクロで承認印のフォーマットを作成したいと思っているのですが、エラーが出てしまいます。
マクロ作成したファイルでは動くのですが、どうもシートの名前を変えてしまうと、「PictureクラスのFormulaプロパティを設定できません」と出てしまいます。何故シートの名前を変えるとこのエラーが出るのか分からず、困っています。対処を教えて頂ければ嬉しいです。

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+r
'

    Range("AS12").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("AS13").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("AS14").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("AS15").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("AS16").Select
    ActiveCell.FormulaR1C1 = "5"
    Range("AT12").Select
    ActiveCell.FormulaR1C1 = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("AT13").Select
    ActiveCell.FormulaR1C1 = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("AT14").Select
    ActiveCell.FormulaR1C1 = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("AT15").Select
    ActiveCell.FormulaR1C1 = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("AT16").Select
    ActiveCell.FormulaR1C1 = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("AU12").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
    Selection.Copy
    Range("AU13:AU16").Select
    ActiveSheet.Paste
    Range("AV12").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""承認"",RC[-1]&RC[-3],""未"")"
    Range("AV12").Select
    Selection.AutoFill Destination:=Range("AV12:AV16"), Type:=xlFillDefault
    Range("AV12:AV16").Select
    Range("AU11").Select
    ActiveCell.FormulaR1C1 = "承認/未承認"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ショウニン"
    ActiveCell.Characters(4, 3).PhoneticCharacters = "ミショウニン"
    Range("AT11:AU16").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AU12:AU16").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("AU12").Select
    ActiveSheet.Protection.AllowEditRanges.Add Title:="範囲1", Range:=Range( _
        "AU12"), Password:="pass"
    Range("AU13").Select
    ActiveSheet.Protection.AllowEditRanges.Add Title:="範囲2", Range:=Range( _
        "AU13"), Password:="pass"
    Range("AU14").Select
    ActiveSheet.Protection.AllowEditRanges.Add Title:="範囲3", Range:=Range( _
        "AU14"), Password:="pass"
    Range("AU15").Select
    ActiveSheet.Protection.AllowEditRanges.Add Title:="範囲4", Range:=Range( _
        "AU15"), Password:="pass"
    Range("AU16").Select
    ActiveSheet.Protection.AllowEditRanges.Add Title:="範囲5", Range:=Range( _
        "AU16"), Password:="pass"

    ActiveSheet.Shapes.AddShape(msoShapeOval, 2442.75, 69.75, 27.75, 36.75).Select
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 41.25
    Selection.ShapeRange.IncrementTop -12
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 42
    Selection.ShapeRange.IncrementTop -12.75
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 42.75
    Selection.ShapeRange.IncrementTop -10.5
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 41.25
    Selection.ShapeRange.IncrementTop -12.75
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 2396.25, 83.25, 30 _
        , 15.75).Select
    Selection.Formula = "=$AT$12"
    Selection.ShapeRange.ScaleWidth 1.05, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2.1428571429, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.880952381, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 1.2666666667, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.Visible = msoFalse
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.IncrementLeft 46.5
    Selection.ShapeRange.IncrementTop -12
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.Copy
    ActiveSheet.Paste
    Selection.Formula = "=$AT$13"
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.IncrementLeft 40.5
    Selection.ShapeRange.IncrementTop -11.25
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 18.75
    Selection.ShapeRange.IncrementTop -29.25
    Selection.Formula = "=$AT$14"
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.IncrementLeft 21.75
    Selection.ShapeRange.IncrementTop 13.5
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft -1.5
    Selection.ShapeRange.IncrementTop -44.25
    Selection.Formula = "=$AT$15"
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.IncrementLeft 44.25
    Selection.ShapeRange.IncrementTop 32.25
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.Copy
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 18
    Selection.ShapeRange.IncrementTop -38.25
    Selection.Formula = "=$AT$16"
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.IncrementLeft 21.75
    Selection.ShapeRange.IncrementTop 24
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Range("AY14").Select

    ActiveWorkbook.Names.Add Name:="未", RefersToR1C1:="=Sheet1!R6C45:R8C45"
    ActiveWorkbook.Names("未").Comment = ""
    Range("AT6:AT8").Select
    ActiveWorkbook.Names.Add Name:="承認1", RefersToR1C1:="=Sheet1!R6C46:R8C46"
    ActiveWorkbook.Names("承認1").Comment = ""
    Range("AU6:AU8").Select
    ActiveWorkbook.Names.Add Name:="承認2", RefersToR1C1:="=Sheet1!R6C47:R8C47"
    ActiveWorkbook.Names("承認2").Comment = ""
    Range("AV6:AV8").Select
    ActiveWorkbook.Names.Add Name:="承認3", RefersToR1C1:="=Sheet1!R6C48:R8C48"
    ActiveWorkbook.Names("承認3").Comment = ""
    Range("AW6:AW8").Select
    ActiveWorkbook.Names.Add Name:="承認4", RefersToR1C1:="=Sheet1!R6C49:R8C49"
    ActiveWorkbook.Names("承認4").Comment = ""
    Range("AX6:AX8").Select
    ActiveWorkbook.Names.Add Name:="承認5", RefersToR1C1:="=Sheet1!R6C50:R8C50"
    ActiveWorkbook.Names("承認5").Comment = ""

    Range("AT1:AV4").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("AT1:AV1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("AT2:AV4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("AT1:AV1").Select
    ActiveCell.FormulaR1C1 = "承認・審査・作成"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ショウニン"
    ActiveCell.Characters(4, 2).PhoneticCharacters = "シンサ"
    ActiveCell.Characters(7, 2).PhoneticCharacters = "サクセイ"

    Range("AT6:AT8").Select
    Selection.Copy
    Range("AT18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC1"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認印1", RefersToR1C1:= _
        "=INDIRECT(Sheet1!R12C48)"
    ActiveWorkbook.Names("承認印1").Comment = ""
    Selection.Formula = "=承認印1"
    Range("AU6:AU8").Select
    Selection.Copy
    Range("AU18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC2"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認印2", RefersToR1C1:= _
        "=INDIRECT(Sheet1!R13C48)"
    ActiveWorkbook.Names("承認印2").Comment = ""
    Selection.Formula = "=承認印2"
    Range("AV6:AV8").Select
    Selection.Copy
    Range("AV18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC3"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認印3", RefersToR1C1:= _
        "=INDIRECT(Sheet1!R14C48)"
    ActiveWorkbook.Names("承認印3").Comment = ""
    Selection.Formula = "=承認印3"
    Range("AW6:AW8").Select
    Selection.Copy
    Range("AW18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC4"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認印4", RefersToR1C1:= _
        "=INDIRECT(Sheet1!R15C48)"
    ActiveWorkbook.Names("承認印4").Comment = ""
    Selection.Formula = "=承認印4"
    Range("AX6:AX8").Select
    Selection.Copy
    Range("AX18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC5"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認印5", RefersToR1C1:= _
        "=INDIRECT(Sheet1!R16C48)"
    ActiveWorkbook.Names("承認印5").Comment = ""
    Selection.Formula = "=承認印5"
    ActiveSheet.Shapes.Range(Array("PIC1")).Select
    Selection.ShapeRange.IncrementLeft -10.5
    Selection.ShapeRange.IncrementTop -215.25
    ActiveSheet.Shapes.Range(Array("PIC2")).Select
    Selection.ShapeRange.IncrementLeft -34.5
    Selection.ShapeRange.IncrementTop -214.5
    ActiveSheet.Shapes.Range(Array("PIC3")).Select
    Selection.ShapeRange.IncrementLeft -50.25
    Selection.ShapeRange.IncrementTop -215.25
    ActiveSheet.Shapes.Range(Array("PIC4")).Select
    Selection.ShapeRange.IncrementLeft -73.5
    Selection.ShapeRange.IncrementTop -216
    ActiveSheet.Shapes.Range(Array("PIC5")).Select
    Selection.ShapeRange.IncrementLeft -96.75
    Selection.ShapeRange.IncrementTop -216.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementTop 0.75

     ActiveSheet.Shapes.Range(Array("PIC1")).Select
    Selection.ShapeRange.IncrementLeft -12
    Selection.ShapeRange.IncrementTop -215.25
    ActiveSheet.Shapes.Range(Array("PIC2")).Select
    Selection.ShapeRange.IncrementLeft -38.25
    Selection.ShapeRange.IncrementTop -216
    ActiveSheet.Shapes.Range(Array("PIC3")).Select
    Selection.ShapeRange.IncrementLeft -56.25
    Selection.ShapeRange.IncrementTop -216
    ActiveSheet.Shapes.Range(Array("PIC4")).Select
    Selection.ShapeRange.IncrementLeft -69
    Selection.ShapeRange.IncrementTop -216
    ActiveSheet.Shapes.Range(Array("PIC5")).Select
    Selection.ShapeRange.IncrementLeft -90
    Selection.ShapeRange.IncrementTop -215.25
    Range("AU16").Select
    ActiveSheet.Shapes.Range(Array("PIC2")).Select
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    ActiveSheet.Shapes.Range(Array("PIC1")).Select
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    ActiveSheet.Shapes.Range(Array("PIC3")).Select
    ActiveSheet.Shapes.Range(Array("PIC2")).Select
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    ActiveSheet.Shapes.Range(Array("PIC3")).Select
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    ActiveSheet.Shapes.Range(Array("PIC4")).Select
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    ActiveSheet.Shapes.Range(Array("PIC5")).Select
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    ActiveSheet.Shapes.Range(Array("PIC4")).Select
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Range("AT1:AV4").Select
    Selection.Copy
    Range("AT18").Select
    ActiveSheet.Pictures.Paste(Link:=True).Select
    Selection.ShapeRange.Name = "PIC6"
    Application.CutCopyMode = False
    ActiveWorkbook.Names.Add Name:="承認・審査・作成", RefersToR1C1:="=""PIC6"""
    ActiveWorkbook.Names("承認・審査・作成").Comment = ""
    Range("AU16").Select
    ActiveWindow.DisplayGridlines = False

End Sub

＜ 使用 Excel：unknown、使用 OS：unknown ＞

---

 VBエディタの検索でSheetを検索してみてくれ。
 >ActiveWorkbook.Names.Add Name:="未", RefersToR1C1:="=Sheet1!R6C45:R8C45"
 や
 >ActiveWorkbook.Names.Add Name:="承認印1", RefersToR1C1:= _
 >"=INDIRECT(Sheet1!R12C48)"
 などシート名が固定になっている部分がある。

（ねむねむ） 2018/12/25(火) 10:31

---

治りました！！ありがとうございます！！
（Charlie） 2018/12/25(火) 14:58

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.