|
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
こんな感じです。
|
|