Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 8 : Excel 2013)
セルの名前を付けてPDF化
投稿日時: 17/09/07 15:10:25
投稿者: 丘珠

何時もお世話になっております。
シート「価値」のセル(D5)とセル47(Q5)の名前を付けてエクセル保存で保存し、別シート「保存」をD5とQ5の名前を付けてPDFとして保存したいのですが。
 
利用しているコードは下記となります。
Private Sub CommandButton2_Click()
    Dim rng As Range
    Dim txt As String
    Dim fs As Variant
    For Each rng In Range("Q10")
    txt = rng.Value
    txt = Replace(txt, " ", "")
    txt = Replace(txt, " ", "")
    rng.Value = txt
  Next rng
  Range("D5:G6").Select
    With Selection.Font
        .Name = "MS P明朝"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("Q15:V15").Select
    ActiveCell.FormulaR1C1 = "未定"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ミテイ"
    Range("IS15").Select
    Range("S2").Value = Date
    ChDrive "S"
 ChDir "S:\1ABT\1709"
With ThisWorkbook.ActiveSheet
  fm = .Range("D5").Text & "(" & .Range("Q10").Text & ")"
End With
fs = Application.GetSaveAsFilename(fm, "MicrosoftExcelブック(*.xlsm),*.xlsm", , "ファイルを保存する", "保存")
If fs = False Then End
ThisWorkbook.SaveAs fs
 
    Range("A1:V32").CopyPicture
    Sheets("写真").Paste Destination:=Sheets("写真").Range("A60")
    Sheets("写真").PageSetup.PrintArea = "$A$1:$L$112"
    Sheets("写真").Select
 
   ※エクセル2016を利用したPDF−−−−−ここでエラーとなります
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "\\PFS01\Profiles$\S002657\Profiles\Desktop\SP-1403244().pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
 ActiveWindow.Close
End Sub

回答
投稿日時: 17/09/07 17:51:00
投稿者: WinArrow
投稿者のウェブサイトに移動

>ここでエラーになります
 
コメント行でエラーは発生しませんよ!
 
具体的なコードと、エラーメッセージくらいは説明しないといけないと思います。
回答者はあなたのPCの画面は見えませんから
もう少し、他人にも見えるように説明しましょう。
 
 
Activesheet
がどれなのかわかりません。
 
PDFは印刷機能ですから、印刷範囲が必要です。
 
シートで修飾をすることに徹底しましょう。
 

回答
投稿日時: 17/09/08 11:35:30
投稿者: Suzu

こんにちは。
 
\\PFS01\Profiles$\S002657\Profiles\Desktop
 
アクセス権 及び 書き込みの権限は持っているのは確認されている状態でしょうか。
 
要は、マクロを実行しているユーザーは、当該フォルダに新規ファイルを作成できますか?
という事です。

回答
投稿日時: 17/09/30 11:54:53
投稿者: simple

# 更新が止まっているスレッドをいくつか拝見しておりました。
# 放置されている理由がわかりませんねえ。
 
>"\\PFS01\Profiles$\S002657\Profiles\Desktop\SP-1403244().pdf
というPDFファイルの名称は、どこからきたものでしょうか。
 
>別シート「保存」をD5とQ5の名前を付けてPDFとして保存したいのですが。
という「仕様」とは全然異なる内容ですよね。シート名も違うし。
 
ExportAsFixedFormatの使い方そのものは正当です。間違っていませんよ。
ネット上にあるコード例をそのまま引っ張ってきただけなんですか?
もしそうだとしたらそのように説明すべきだし、手を抜き過ぎとしか言えません。
 
------------------------
以下、余談、つけたしです。
 
ついでに関連すると思われる、貴兄の別の質問スレッドも覗いてきました。
「印刷・保存でエラー」
http://www.moug.net/faq/viewtopic.php?t=75953
 
>ファイルのフルパスを作るのにわさわざダイアログボックスを開かなくても、
>文字列を作ればいいです。

と有益なコメントがされているのに、今回も同じ方式ですね。
取り入れようとされないのは何故ですか?
そのファイル名をもとに、微修正(例えば、連番を追加など)をする、なら理解できます。
そうでないなら、ダイアログ表示して手を掛ける意味はないわけです。
折角の助言を活かさなければ、こうした質問掲示板で質問されている意味が薄れると思います。
他人のコメントを是非活かすようにしてください。

回答
投稿日時: 17/09/30 23:12:42
投稿者: simple

後半部分を書いてみるとこんな感じでしょうか。

    Dim folder As String
    Dim fm As String
    
    folder = "S:\1ABT\1709\"
    fm = Range("D5").Text & "(" & Range("Q10").Text & ")"
    ThisWorkbook.SaveAs folder & fm & ".xlsm"

    Range("A1:V32").CopyPicture
    Sheets("写真").Paste Destination:=Sheets("写真").Range("A60")
    Sheets("写真").PageSetup.PrintArea = "$A$1:$L$112"

    'pdfファイルに保存
    Sheets("写真").ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=folder & fm & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

テストもしていませんが、参考になれば幸いです。

トピックに返信