• ベストアンサー

excel マクロ Selection.Formula

VBA初心者です。 excelの表に文字を記入して、それをカード化したいと思ってます。 テキストボックスをN回コピーして、それぞれに名前をつけて、またそれぞれにテキストが入力されたセルへ参照先を指定したいのですが、上手くいきません。 Dim n As Integer 'カードのコピー回数はD4のセルを参照 n = Range("input!D4").Value If n >= 1 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card1" Selection.Formula = "=formula!B6" End If If n >= 2 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card2" Selection.Formula = "=formula!B7" End If If n >= 3 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card3" Selection.Formula = "=formula!B8" End If If n >= 4 Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card4" Selection.Formula = "=formula!B9" と延々と50回繰り返してます。 希望は150~200回繰り返したいのですが、 マクロ記録などや他の回答などを参考にしながら、 初心者なりに考えて、 Sub cardproductionA4() 'カードのコピー回数を指定 N=総回数 P=1~N回 Dim N As Integer, P As Integer N = Range("input!D4").Value 'カードのコピー For P = 1 To N If N >= P Then ActiveSheet.Shapes("card0").Select Selection.Copy ActiveSheet.Paste Selection.Name = "card" & CStr(P) Selection.Formula = "=formula!B(P+5)" End If Next P End Sub としました。 でも、参照先が漸次変わっていって欲しいのですが、 Selection.Formula の先がエラーで出来ません。 どのように記述すれば宜しいのでしょうか? あるいは、そもそもVBAを理解していないので、間違っているのかもしれませんが、 御教授お願い致します。

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

  • ベストアンサー
  • nattocurry
  • ベストアンサー率31% (587/1853)
回答No.2

Selection.Name = "card" & CStr(P) これができるなら、 Selection.Formula = "=formula!B(P+5)" これがどうおかしくて、どうすれば良いかも解る筈なんですけどねぇ。 Selection.Formula = "=formula!B" & CStr(P + 5) にしてみましょう。

tkh_tkh
質問者

お礼

出来ました!!! ありがとうございます!!! 確かに、おっしゃるとおりですね、でも目から鱗でした!!!

その他の回答 (1)

  • FEX2053
  • ベストアンサー率37% (7987/21355)
回答No.1

検証してませんが、ココまで来るレベルなら分かるでしょう。 Selection.Formula = "=formula!B(P+5)" これじゃあ「文字列B!(P+5)」がそのまま貼り付けられます。 Pを数字に見なして()内は計算しちゃくれません。 P+5を具体的な数字にして貼り付けたいなら、"=formula・・・" の文字列全体を計算して作らないとダメですよ。

tkh_tkh
質問者

お礼

御回答ありがとうございます。 Selection.Formula ="" で" "の中身を考えていたのですが、 どうにも分からなかったのです。 でも、なんとなく、方針が掴めそうな気がします。複雑ですね。 アドバイスありがとうございます!!!

関連するQ&A

  • やはり図形のクリアで実行時エラー1004

     図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing  (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub

  • Excel 2010 で勤務割表を作成しています。

    月間の勤務割表を作成しています。 3列3行を一枡として一人・一日の枡とし、勤務の割り振り状態を表示するものです。 列に日付、行を個人名(max16名)としますから、3列3行の枡が496個となります。 各枡とも1列目の1行目に勤務種別コード(1~5)を記述し、このコードNoにより4種の図形を貼付けています。 1つ1つの枡(496個)に以下のコードを書き実行しています。膨大な行数を要します。 使用するパソコンにおいては実行速度がかなりかかります。 これをもっと単純化する手法についてご教示いただければ幸いです。 Sub Macro1() Select Case Range("I6").Value '1人目-1日 Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Range("J7").Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Range("I7").Select ActiveSheet.Paste Case 3: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("J7").Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("直線1").Select Selection.Copy Range("I6").Select ActiveSheet.Paste Case 9: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("J7").Select ActiveSheet.Paste End Select  '|   '| <同じことを一つ一つの枡ごとに繰り返し記述しています。>   '| Select Case Range("CU51").Value '16人目-31日 Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Range("CU52").Select ActiveSheet.Paste Case 3: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("直線1").Select Selection.Copy Range("CU51").Select ActiveSheet.Paste Case 9: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste End Select End Sub

  • excel2000マクロについて

    下記の様なマクロを書いていますが、別のマクロの記述の仕方で短縮に書くことはできないでしょうか。 Sub 承認捺印() Sheets("実行").Select If Range("E13").Value = "申請者" Then Sheets("ログイン").Select If Range("F11").Value = "a8012661" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 15").Copy Call 申請者捺印 End If If Range("F11").Value = "a6601456" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 16").Copy Call 申請者捺印 End If If Range("F11").Value = "t9907028" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 17").Copy Call 申請者捺印 End If If Range("F11").Value = "a7545410" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 18").Copy Call 申請者捺印 End If If Range("F11").Value = "t9806047" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 19").Copy Call 申請者捺印 End If If Range("F11").Value = "t0206030" Then Sheets("印章").Select ActiveSheet.Shapes("Picture 20").Copy Call 申請者捺印 End If  end if end sub Sub 申請者捺印() Sheets("報告票").Select Range("m3").Select ActiveSheet.Paste Range("a1").Select End Sub

  • マクロが実行しない

     二行三列を一枡として月の勤務割表を作成しています。マクロで同じ事を しているのにMacro1の方が実行しません。お教え願えませんでしょうか。 (尚、図形を枠線上にコピペしています。) Sub Macro1()実行しません。 Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 10 To 103 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste End Select Next Next End Sub Sub Macro2()実行します。 ActiveSheet.Shapes.Range(Array("四角形1")).Select Selection.Copy Range("J11:K11").Select ActiveSheet.Paste End Sub

  • Excel マクロ 任意のセルから実行したい

    こんにちは、Excel2003を使用しています。 ExcelでK55からE55までのセルの値を削除して(空白にして) それぞれに「---を引いた透明のダイアローグボックス」を コピーしていくマクロを作成したことがあります。 このときは開始するセルがK55と決まっていたのですが 今度は任意のセルから(たとえば選択したセルの右隣とか) 実行したいのですがどのようにマクロを作ればよいでしょうか ご存じの方お教えください。 なお参考に上記のマクロを記載します。 Range("E55:J55").Select Selection.ClearContents Range("H55").Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 672#, 729#, _ 81#, 13.5).Select Selection.Characters.Text = "" With Selection.Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.Fill.Solid 'Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoFalse ActiveSheet.Shapes("Text Box 12").Select Selection.Characters.Text = "---" With Selection.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.HorizontalAlignment = xlCenter Range("K55").Select ActiveSheet.Shapes("Text Box 12").Select Selection.Copy Range("I55").Select ActiveSheet.Paste Range("H55").Select ActiveSheet.Paste Range("G55").Select ActiveSheet.Paste Range("F55").Select ActiveSheet.Paste Range("E55").Select ActiveSheet.Paste Range("E56").Select Selection.Copy Range("F56:J56").Select ActiveSheet.Paste Application.CutCopyMode = False Range("E56:J56").Select Selection.Copy Range("E57:E59").Select ActiveSheet.Paste Application.CutCopyMode = False Range("K59").Select End Sub

  • Excel VBA if文 マクロ強制終了するには?

    現在 2つのbookがあります。 ・データ data.xls ・集計 total.xls ★条件は以下 ・この2つのbookには同じ名前の 『sheet名・数』が情報保持しています。 ・sheet名は不特定の名前が付けられています。 ★処理したいマクロ内容 ・data.xls …の各sheet と total.xls 各sheet参照させて マッチしたら処理。 マッチしなかったらマクロ強制終了。 Sub match() Dim i As Integer For i = 1 To Worksheets.Count '任意のbookを指定します Windows("data.xls").Activate sheet_copy = ActiveSheet.Name Sheets(sheet_copy).Select '範囲を選択 コピーします Range("C2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy On Error Resume Next '---前後にシートが無い場合のエラーを無視 ActiveSheet.Next.Select '任意のbook と sheet を指定します Windows("total.xls").Activate sheet_paste = ActiveSheet.Name Sheets(sheet_paste).Select Range("D2").Select If sheet_copy = sheet_paste Then ActiveSheet.Paste ActiveSheet.Next.Select Else MsgBox "sheet miss match error!" '★マクロ強制終了 End If Next i End Sub ★部分に何と記述すればよろしいでしょうか? アドバイスお願い致します。

  • EXCELのVBAについて

    マクロのボタンで内容を削除する様に設定した所、 Dim re As Integer Sheets("投入シート").Select re = MsgBox("入力データをクリアします。" & vbCrLf & vbCrLf & "よろしいですか?", vbOKCancel, "クリア確認") If re <> vbCancel Then Sheets("投入シート").Select ActiveSheet.Unprotect Range("a1:c30").Select Selection.Copy Application.CutCopyMode = False Selection.Copy Sheets("work").Select Range("A1").Select ActiveSheet.Paste Sheets("投入シート").Select ActiveSheet.Unprotect Range("c4:c30").Select Selection.ClearContents Range("f31").Select Selection.Copy Range("c9").Select ActiveSheet.Paste Range("f33").Select Selection.Copy Range("c11").Select ActiveSheet.Paste Range("f32").Select Application.CutCopyMode = False Selection.Copy Range("c14").Select ActiveSheet.Paste Range("c4").Select Application.CutCopyMode = False 'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If Sheets("投入シート").Select Range("c4").Select End Sub この様に入力したのですがセルのC11の計算式だけセル番号が消えてしまいます。 どうしてでしょうか?ご指導をお願いします。

  • エクセルマクロの分割方法について

    Sub リスト登録() ' ' Macro3 Macro ' マクロ記録日 : 2008/6/2 ' ActiveSheet.Unprotect Password:="1234" If Range("G33").Value > 5 Then Sheets("リスト").Select ActiveSheet.Shapes("AutoShape 44").Select Selection.Copy Sheets("シート").Select Range("A15").Select ActiveSheet.Paste End If Dim Btn As Integer Dim strMsg As String strMsg = "リストに登録しますか?" Btn = MsgBox(strMsg, vbYesNo + vbQuestion, "MsgBox") If Btn = vbNo Then Dim YU As Shape For Each YU In ActiveSheet.Shapes If YU.Type = msoAutoShape Then YU.Delete End If Next If Btn = vbYes Then End If ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True Range("C11").Select End End If Dim newRange1 As Range, newRange2 As Range, newRange3 As Range Select Case Sheets("").Range("B3").Value Case 1 Set newRange1 = Sheets("リスト").Range("I6") Set newRange2 = Sheets("リスト").Range("AH6") Set newRange3 = Sheets("リスト").Range("AI6") 中略 Case 1000 Set newRange1 = Sheets("リスト").Range("I1005") Set newRange2 = Sheets("リスト").Range("AH1005") Set newRange3 = Sheets("リスト").Range("AI1005") ActiveWorkbook.Save Case Else End Select Application.ScreenUpdating = False Sheets("シート").Range("G8,G10,G12:G23,G25:G29,G31:G32").Copy newRange1.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True newRange1.UnMerge Sheets("シート").Range("D34").Copy newRange2.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("シート").Range("I29").Copy newRange3.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("シート").Select Range("C11").Select Range("D34,G8:G32,I29").Select Selection.ClearContents Range("C11").Select Dim SP As Shape For Each SP In ActiveSheet.Shapes If SP.Type = msoAutoShape Then SP.Delete Range("D34:K34").Select Application.CutCopyMode = False Selection.Merge Range("B3").Select End If Next ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub 上記のマクロを作成しましたが、64Kを超えてしまう為、分割したいのですが、どのように分割すればよいのか方法がわかりません、どなたかお分かりの方がいらっしゃいましたら宜しくお願いします。 マクロシート1~2~3といったつなぎの構文がわかりません宜しくお願い致します。

  • エクセル マクロで引いた線の色設定が戻せない

    エクセルで作成した、出席簿にマクロで 土日などに赤線で罫線の間に縦に オートシェィプ直線を引いています。 次に転出者の欄には、横に線をマクロで引いていますが 色が変えられません。 マクロ終了後もオートシェイプの線色は黒でも 、線を引くと赤のままです。 その線を選択して、色を変えないと 変えられない状態です。 マクロ終了前に、色をリセットする事は出来ませんか? 下記の内容がマクロの一部です。 よろしくお願いします。 If yobi = doyo Or yobi = niti Then Cells(3, 2 + n).Activate If yobi = niti Then With Selection.Font .ColorIndex = 3 End With End If ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 42, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '10=赤色 End If If yobi = "" Then ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 14.25, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 '8=黒色 End If

  • エクセル「マクロの記録」を少し直したい

    マクロの記録で作った下記を Sub Macro1() Sheets("Sheet1").Select Rows("6:6").Select Selection.Copy Sheets("Sheet2").Select Rows("2:2").Select ActiveSheet.Paste End Sub 以下のように書き換えたら、2行目(Paste)がエラーになりました。 Sub ts1() Sheets("Sheet1").Rows("6:6").Copy Sheets("Sheet2").Rows("2:2").Paste End Sub セレクトしないで行ないたいのです。 どう直せばいいでしょうか?

専門家に質問してみよう