こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルでセル内容でpdfで保存しメールの起動まで

長くなってしまって済みません。

先日(2018/12/28)ここで上記のマクロのコードを教えてもらって問題なく使い始めたのですが、別のBookにコピーして、ファイル名のセルを(10,4)と(1,1)から(15,4)と(1,1))に変更すると「実行時エラー 13、型が一致しません」と出ます。
うまくいっているシートのファイル名はD10+A1のセルで、今度はD15+A1をファイル名にしただけなのですが。。。。

(10,4)と(1,1)のままだと普通にメールが起動してくるのですがD10が空白セルの為A1の内容だけでファイル名になってしまいます。
ちなみにそのシートのD10に数値+アルファベットを入れると「型が一致しません」と上記と同じエラーが出ます。

教えてもらったコードのファイル名の(下の)セルの数値だけ変えたらうまくいったと思うのですが、今回はなぜかエラーになってしまいます。
質問ではA1+B1で質問しましたので(1,1)と(1,2)になっています。
xFolder = PdfDir + "\" + xSht.Cells(1, 1).Value & xSht.Cells(1, 2).Value + ".pdf"

全部のコードは下記の通りです。
Option Explicit

Sub Saveaspdfandsend()
Dim xSht As Worksheet
'Dim xFileDlg As FileDialog
Dim xFolder As String
'Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Const PdfDir = "C:\OKWave"  'PDFを保存するフォルダー

Set xSht = ActiveSheet
'Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
'
'If xFileDlg.Show = True Then
'  xFolder = xFileDlg.SelectedItems(1)
'Else
'  MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
'  Exit Sub
'End If
xFolder = PdfDir + "\" + xSht.Cells(1, 1).Value & xSht.Cells(1, 2).Value + ".pdf"

'Check if file already exist
'If Len(Dir(xFolder)) > 0 Then
'  xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
'           vbYesNo + vbQuestion, "File Exists")
'  On Error Resume Next
'  If xYesorNo = vbYes Then
'    Kill xFolder
'  Else
'    MsgBox "if you don't overwrite the existing PDF, I can't continue." _
'          & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
'    Exit Sub
'  End If
'  If Err.Number <> 0 Then
'    MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
'          & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
'    Exit Sub
'  End If
'End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
  'Save as PDF file
  xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
  
  'Create Outlook email
  Set xOutlookObj = CreateObject("Outlook.Application")
  Set xEmailObj = xOutlookObj.CreateItem(0)
  With xEmailObj
    .Display
    .To = ""
    .CC = ""
    .Subject = ""
    .Attachments.Add xFolder
    'If DisplayEmail = False Then
      '.Send
    'End If
  End With
Else
 MsgBox "The active worksheet cannot be blank"
 Exit Sub
End If
End Sub

投稿日時 - 2019-02-05 10:54:41

QNo.9584860

困ってます

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

xFolder = PdfDir + "\" + xSht.Cells(15, 4).Text & xSht.Cells(1, 1).Text + ".pdf"

とすると期待通り動くものと思います。

投稿日時 - 2019-02-05 12:03:27

補足

いつもお世話になっております。

早々かつ度々のご回答ありがとうございます。
朝一で「動かない」と指摘されて、最初のBookでは何度やっても問題なく動くことから、セル番地だけの問題と何度も試行錯誤していたのが全く無駄だったことに無力感、とすんなり解決したことに感謝です。

投稿日時 - 2019-02-05 13:26:22

お礼

早々のご回答ありがとうございます。

最初はどこが違うのか分かりませんでしたが、並べてみたらValueがTEXTになっていました。
最初のBookではC&Pの後数字だけ変えてValueのままで動いたのに不思議です。

このコードはこれからも汎用になるので、こんなレベルで使うには少し不安もありますが今更以前のように、(1)ファイル名をつけて、(2)所定のフォルダを探して、(3)pdfで保存して、(4)そのファイルをフォルダから探して、(5)メールに添付して、(6)シートごとに決まった宛名を入れて送信。。。はできないので非常に助かりました。

複数の人がこの作業をやるのですが、1人の人には上記の6つの作業はハードルが高く、1人の人は入力ミスが多いので本当に助かりました。

投稿日時 - 2019-02-05 13:14:10

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

(2018/12/28)の時には、掲示サイトからそのままコピペしました。
よく見ると文字演算で + を使っていますね。

xFolder = PdfDir & "\" & xSht.Cells(15, 4).Text & xSht.Cells(1, 2).Text & ".pdf"
とすれば、より確実です。


 

投稿日時 - 2019-02-05 12:36:20

お礼

本当に色々ありがとうございます。
+は使用した覚えがなく、というかそんな知識がありません。

ここからコピペしたときに+になったハズです。
同じような現象で¥は\になるものと思いました。
ご回答コードを\のままマクロに貼り付けたら¥に戻ったと思います。

今確認したらコピペしたはずなのに、同じ行に+と&が混在していましたので原因(規則性)不明。
気持ち悪いので&に修正して(も)正常に動くことを確認しました。

残念ながら当方に\を+に変える知識はありません。(ご存知の通り)

投稿日時 - 2019-02-05 17:17:49

ANo.2

>質問ではA1+B1で質問しましたので(1,1)と(1,2)になっています。
>xFolder = PdfDir + "\" + xSht.Cells(1, 1).Value & xSht.Cells(1, 2).Value + ".pdf"
>(15,4)と(1,1))に変更すると
Range("D15") と Range("A1") ですね
なら
xFolder = PdfDir & "\" & xSht.Range("D15").Value & xSht.Range("A1").Value & ".pdf"
文字の連列は & で行いましょう
MsgBox xFolder で連結後の確認もしてみましょう

投稿日時 - 2019-02-05 12:08:51

補足

いつもお世話になっております。
早々のご回答に感謝!!

試してみたのですが赤●の中に×が入って400というエラー表示が出ます。
他のマクロではRange()を使っているので、Range()でも行けるということだと思いますが当方のことですので何かの手違いも。。。自信なし。

いずれにしても#No1さんのご回答で解決しましたのでこれ以上のお手数は結構です。

投稿日時 - 2019-02-05 13:35:37

お礼

ご回答でうまく行くことが確認出来ました。

Range()で出来ないのはなぜ?が有ったので色々試行錯誤してみたところ、指定したセルが空白の場合はエラーになるようです?
ちょっとした確認不足、大きな知識不足ですみませんでした。

上記訂正とお詫びします。

投稿日時 - 2019-02-05 16:28:50

あなたにオススメの質問