• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:excel2000マクロについて)

Excel2000マクロでの承認捺印の方法

このQ&Aのポイント
  • Excel2000のマクロを使用して、申請者による承認捺印を行いたい場合、下記のようにマクロを書くことができます。
  • マクロを短縮する方法はありませんが、別のマクロの記述方法を使用することで、コードの簡略化ができます。
  • 具体的なマクロの記述方法や、申請者捺印の処理の流れについては、質問文章をご参照ください。

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

できれば、捺印は、Copy よりも、jpg などの別ファイルにして、挿入したほうが問題が少ないです。 私の経験では、オブジェクトの貼り付け削除の繰り返しを千回以上になると、時々、トラブルを起こすことがあります。 また、Option Base の 1 とは共用する場合は、 myValue = Array(.. , .. , ..) lastindex = UBound(ar) - 1 ReDim Preserve myValue(0 To lastindex) とひとつずらすか、"Picture " & i + 14 にしてください。 '<標準モジュール> Sub 承認捺印()  Dim myValue As Variant  Dim ShapeName As String, i As Long  '配列による設定  myValue = Array("a8012661", "a6601456", "t9907028", "a7545410", "t9806047", "t0206030")     If Sheets("実行").Range("E13").Value = "申請者" Then    For i = LBound(myValue) To UBound(myValue)     If Sheets("ログイン").Range("F11").Value = myValue(i) Then      ShapeName = "Picture " & i + 15      Sheets("印章").Shapes(ShapeName).Copy      With Sheets("報告票")        Application.Goto .Range("m3")        .Paste        'オブジェクトが見えなくなることがあるのでVisibleをTrue        .Shapes(ShapeName).Visible = msoTrue        .Range("A1").Select        Exit For       End With     End If    Next   End If End Sub

すると、全ての回答が全文表示されます。

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.3

(1)まずマクロの記録に由来するかと思うSELECTはやめてはどうですか Sheets("ログイン").Select If Range("F11").Value = "a8012661" Then はSheets("ログイン").Range("F11")= "a8012661" Then (2)VALUEも省略しては 反対のかたもいるかも知れないが。 (3)私はARRAYを2つ作り、同順序に並べてよくやります。 a=Array("a8012661","a6601456",・・・) b=Array("15","16",・・・) aを探して何番目かわかった場合にbの何番目かのデータを取るという風に。 あまり数が多いと使いませんが。 多いときは対応表をファイルとしてもち、最初に読んで配列に入れて同じことをやります。

すると、全ての回答が全文表示されます。
  • mshr1962
  • ベストアンサー率39% (7417/18945)
回答No.1

こんなもので如何 Sub 承認捺印() Sheets("印章").Select If Worksheets("実行").Range("E13").Value = "申請者" Then  Select Case Worksheets("ログイン").Range("F11").Value  Case "a8012661"   ActiveSheet.Shapes("Picture 15").Copy    Case "a6601456"   ActiveSheet.Shapes("Picture 16").Copy  Case "t9907028"   ActiveSheet.Shapes("Picture 17").Copy  Case "a7545410"   ActiveSheet.Shapes("Picture 18").Copy  Case "t9806047"   ActiveSheet.Shapes("Picture 19").Copy  Case"t0206030"   ActiveSheet.Shapes("Picture 20").Copy  Case Else   Exit Sub  End Select   Call 申請者捺印 End If End Sub

すると、全ての回答が全文表示されます。

専門家に質問してみよう