Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13439 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【5314】Cellの書式コピー keanu 03/5/6(火) 15:45 質問
【5323】Re:Cellの書式コピー りん 03/5/6(火) 18:23 回答
【5332】Re:Cellの書式コピー keanu 03/5/7(水) 10:12 質問
【5350】Re:Cellの書式コピー Kein 03/5/7(水) 17:42 回答
【5359】Re:Cellの書式コピー keanu 03/5/8(木) 8:58 質問
【5366】Re:Cellの書式コピー Kein 03/5/8(木) 15:19 回答
【5417】Re:Cellの書式コピー keanu 03/5/12(月) 13:32 お礼
【5314】Cellの書式コピー
質問  keanu  - 03/5/6(火) 15:45 -
引用なし
パスワード
   Sheets("フォーム").Range("**")の書式ごとRange("**")にコピーしたいのですがどうすればいいでしょうか？

Sub 一枚目印刷()

　　Sheets("フォーム").Range("B1") = Range("B1")
　　Sheets("フォーム").Range("B2:B9").Value = Range("A2:A9").Value

　　Sheets("フォーム").Range("B12") = Range("B12")
　　Sheets("フォーム").Range("B13:B20").Value = Range("A13:A20").Value

　　Sheets("フォーム").Range("B23") = Range("B23")
　　Sheets("フォーム").Range("B24:B31").Value = Range("A24:A31").Value

　　Sheets("フォーム").Range("U1") = Range("L1")
　　Sheets("フォーム").Range("U2:U9").Value = Range("K2:K9").Value

　　Sheets("フォーム").Range("U12") = Range("L12")
　　Sheets("フォーム").Range("U13:U20").Value = Range("K13:K20").Value

　　Sheets("フォーム").Range("U23") = Range("L23")
　　Sheets("フォーム").Range("U24:U31").Value = Range("K24:K31").Value

　　henji = MsgBox("プリンターの設定はお済ですか？", vbYesNo)
　　If henji = vbNo Then Exit Sub
　　Set hani = Worksheets("フォーム").Range("A1:V31")
　　'hani.PrintOut
　　hani.PrintPreview
End Sub
【5323】Re:Cellの書式コピー
回答  りん E-MAIL  - 03/5/6(火) 18:23 -
引用なし
パスワード
   keanu さん、こんばんわ。

>Sheets("フォーム").Range("**")の書式ごとRange("**")にコピーしたいのですがどうすればいいでしょうか？

ベタなやりかたですが。
形式を選択して貼り付け　→　書式　形式を選択して貼り付け　→　値　
を必要回数繰り返しました。

Sub 一枚目印刷()
　 Dim Rstr(1 To 2) As String,tp%
　 For tp% = 1 To 12
　　　Select Case tp%
　　　　 Case 1:　Rstr(1) = "B1":　　　Rstr(2) = "B1"
　　　　 Case 2:　Rstr(1) = "B2:B9":　 Rstr(2) = "A2:A9"
　　　　 Case 3:　Rstr(1) = "B12":　　 Rstr(2) = "B12"
　　　　 Case 4:　Rstr(1) = "B13:B20": Rstr(2) = "A13:A20"
　　　　 Case 5:　Rstr(1) = "B23":　　 Rstr(2) = "B23"
　　　　 Case 6:　Rstr(1) = "B24:B31": Rstr(2) = "A24:A31"
　　　　 Case 7:　Rstr(1) = "U1":　　　Rstr(2) = "L1"
　　　　 Case 8:　Rstr(1) = "U2:U9":　 Rstr(2) = "K2:K9"
　　　　 Case 9:　Rstr(1) = "U12":　　 Rstr(2) = "L12"
　　　　 Case 10: Rstr(1) = "U13:U20": Rstr(2) = "K13:K20"
　　　　 Case 11: Rstr(1) = "U23":　　 Rstr(2) = "L23"
　　　　 Case 12: Rstr(1) = "U24:U31": Rstr(2) = "K24:K31"
　　　End Select
　　　ActiveSheet.Range(Rstr(2)).Copy
　　　With Worksheets("フォーム").Range(Rstr(1))
　　　　 .PasteSpecial Paste:=xlValues
　　　　 .PasteSpecial Paste:=xlFormats
　　　End With
　　　Application.CutCopyMode = False
　 Next
　 Erase Rstr
　 '
　 henji = MsgBox("プリンターの設定はお済ですか？", vbYesNo)
　 If henji = vbNo Then Exit Sub
　 Set hani = Worksheets("フォーム").Range("A1:V31")
　 'hani.PrintOut
　 hani.PrintPreview
End Sub

こんな感じです。
【5332】Re:Cellの書式コピー
質問  keanu  - 03/5/7(水) 10:12 -
引用なし
パスワード
   りん さん ありがとうございます。
今試したところxlvaluesのところでエラーがでましたがxlvalueでいいのでしょうか？
【5350】Re:Cellの書式コピー
回答  Kein  - 03/5/7(水) 17:42 -
引用なし
パスワード
   xlValues　→ xlPasteVaules
xlFormats → xlPasteFormulas

に、してみたらどうでしょーか ?
【5359】Re:Cellの書式コピー
質問  keanu  - 03/5/8(木) 8:58 -
引用なし
パスワード
   ▼Kein さん：
>xlValues　→ xlPasteVaules
>xlFormats → xlPasteFormulas
>
>に、してみたらどうでしょーか ?

.PasteSpecial Paste:=xlPasteVaulesの行でエラーになってしまうのですがどうしたらいいでしょうか？
【5366】Re:Cellの書式コピー
回答  Kein  - 03/5/8(木) 15:19 -
引用なし
パスワード
   Sub 一枚目印刷()
　　Dim henji As Integer

　　henji = MsgBox("プリンターの設定はお済ですか？", vbYesNo)
　　If henji = 7 Then Exit Sub
　　With Sheets("フォーム")
　　　 .Range("A2:A31").Copy .Range("B2")
　　　 .Range("K2:K31").Copy .Range("U2")
　　　 Uion(.Range("B10:B12"), .Range("B21:B23"), _
　　　 .Range("U10:U12"), .Range("U21:U23")).ClearContents
　　　 .Range("L1").Copy .Range("U1")
　　　 .Range("L12").Copy .Range("U12")
　　　 .Range("L23").Copy .Range("U23")
　　　 .Range("A1:V31").PrintOut Copies:=1, Printpreview:=True
　　End With
End Sub

で、どうですか ?
【5417】Re:Cellの書式コピー
お礼  keanu  - 03/5/12(月) 13:32 -
引用なし
パスワード
   ▼Kein さん：
>Sub 一枚目印刷()
>　　Dim henji As Integer
>
>　　henji = MsgBox("プリンターの設定はお済ですか？", vbYesNo)
>　　If henji = 7 Then Exit Sub
>　　With Sheets("フォーム")
>　　　 .Range("A2:A31").Copy .Range("B2")
>　　　 .Range("K2:K31").Copy .Range("U2")
>　　　 Uion(.Range("B10:B12"), .Range("B21:B23"), _
>　　　 .Range("U10:U12"), .Range("U21:U23")).ClearContents
>　　　 .Range("L1").Copy .Range("U1")
>　　　 .Range("L12").Copy .Range("U12")
>　　　 .Range("L23").Copy .Range("U23")
>　　　 .Range("A1:V31").PrintOut Copies:=1, Printpreview:=True
>　　End With
>End Sub
>
>で、どうですか ?

遅くなって申し訳有りませんでした。
さっそくためしてみます皆様ありがとうございました＾＾
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13439 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free