• 締切済み

マクロの動作不良

エクセルに下のようなボタンマクロを設定しています。 内容は、inpシートに設定している開始番号と終了番号を入力するとその番号分だけreceptシートのでーたを入れ替えてPDFで吐き出すというコードです。 問題なく動いていたのですが、先日、PCを入れ替えた際に確認したところ、pdfが出力されなくなりました。特にエラーはでることなく完了するのですがファイルができません。 変な質問ですが、原因がつかめず困っております。 このエクセルファイルは旧PCでも、新PCでもSDカードに保存して使用しております。 宜しくお願い致します。 Sub ボタン6_Click() Dim s As Long Dim e As Long Dim i As Long Dim outputFilePath As String Dim outputFileName As String On Error Resume Next s = InputBox("開始No.を入力して下さい。") If s = 0 Then Exit Sub e = InputBox("終了No.を入力して下さい。") If e = 0 Then Exit Sub ' PDFの保存先フォルダを指定する outputFilePath = Environ("USERPROFILE") & "\Desktop\" For i = s To e ' 出力するファイル名を指定する outputFileName = "recept_" & i & ".pdf" ' 対象の番号を設定する Worksheets("Inp").Range("C1").Value = i ' PDF出力を行う With Worksheets("Recept").Range("A36:J74") .ExportAsFixedFormat Type:=xlTypePDF, _ fileName:=outputFilePath & outputFileName, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False End With ' 作成したファイル名を表示する MsgBox "PDFファイルを作成しました: " & outputFilePath & outputFileName Next i End Sub

  • verify
  • お礼率44% (384/858)

みんなの回答

  • kkkkkm
  • ベストアンサー率65% (1622/2462)
回答No.10

回答No.9の追加です。 デスクトップのパス (現状ログインしているユーザー「過去の結果ではなくUSERPROFILEでのDesktopをその時点で確認して」で見てください。複数ユーザーの場合、USERPROFILEは外せないと思います) が両方とも同じでしたら コードの .ExportAsFixedFormat Type:=xlTypePDF, _ fileName:=outputFilePath & outputFileName, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False の以下の部分 Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False をはずして .ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=outputFilePath & outputFileName だけにして試してみてみるとか PDFではなく単にエクセルファイルをそのまま保存して試してみるとかで、保存自体に問題があるかどうか確認したり、デスクトップにファイルが保存できるかどうかも確認してみてもいいかもしれません。

  • kkkkkm
  • ベストアンサー率65% (1622/2462)
回答No.9

とりあえず、ファイルフォルダでデスクトップのあるところを表示してそのパスと NuboChanさんのNo.5の回答にあるコードで取得したデスクトップのパスと同じかどうか確認してみてはいかがでしょう。 デスクトップのPCからOS→ユーザー→現在のユーザー名→デスクトップで表示されたときが画像の上の状態で、デスクトップの右あたりをクリックすると画僧の下のように表示されます。 そのパスと比較してみてください。 クイックアクセスのデスクトップではなく必ず「OS」から進んでください。 画像の赤のxxxxxxxxは後で細工したもので実際のものではありません。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.8

Environ("UserProfile") この戻り値が、 実行しているユーザのユーザプロファイルのフォルダーではないということのように思います。 この仮説が正しいなら、私だったら Environ("UserProfile") を使わず、  "c:\Users\toiiz\Desktop" を使います。 つまり、 outputFilePath = Environ("USERPROFILE") & "\Desktop\" を outputFilePath = "c:\Users\toiiz\Desktop" に書き換えます。 ユーザプロファイルにこだわるなら https://www.ubackup.com/jp/windows-10/backup-user-profile-windows-10.html といったサイトを参考に、ユーザプロファイルを引っ越す、 あるいは、新たなアカウントを用意し 必要なデータたちを複写します。

  • NuboChan
  • ベストアンサー率47% (745/1584)
回答No.7

すいません。 ミス書き込み、以下のように訂正(加筆)します。 以下から考えて outputFilePath = Environ("USERPROFILE") & "\Desktop\" outputFileName = "recept_" & i & ".pdf" c:\Users\toiiz\Desktop が存在しているのであれば C:\Users\toiiz\Desktop\recept_1.pdf として出力されるはずですが C:¥users¥to¥desktoprecept_1.pdf に現在出力されているのは理解できません。

  • NuboChan
  • ベストアンサー率47% (745/1584)
回答No.6

c:\Users\toiiz\Desktop が存在しているのであれば c:\Users\toiiz\Desktop\desktoprecept_1.pdfとして出力されるはずですが C:¥users¥to¥desktoprecept_1.pdf に現在出力されているのは理解できません。

  • NuboChan
  • ベストアンサー率47% (745/1584)
回答No.5

>環境変数というのはOSバージョンごとに異なるのでしょうか。 win11でもWin10と仕様は変わらないはずです。 >uses直下のフォルダ(C:¥users¥to¥)に”desktoprecept_1.pdfとして出力されました。 デスクトップディレクトリーがおかしくないですか? (デスクトップのフルパスは想定の名前か、確認が必要です) とりあえず、下記ののコードを追加すると  どのように表示されますか ? MsgBox "ユーザー名は" & vbLf & Environ("USERNAME") MsgBox "デスクトップのパスは" & vbLf & Environ("UserProfile") & "\Desktop"

verify
質問者

補足

引き続き、ご回答ありがとうございます。 コードを追加実行すると、ユーザ名はtoiiz、デスクトップのパスは、c:\Users\toiiz\Desktopとなりました。宜しくお願い致します。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.4

>PDF生成のコードが黄色く反転しました。 >しかし、どうも他の方が指摘くださったように >新PCのパスの変数?のようです。 どのコードでどのようなエラーメッセージなのかを説明すれば コメントできるかもしれません。 なお、 環境変数から取得するフォルダーが期待通りかどうかは 添付画像で確認する方法と Sub aaa() MsgBox Environ("USERPROFILE") End Sub といったコードを実行すれば確認できるものと思います。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

アウトプット先がDesktop\"となっているので、デスクトップにPDFファイルが作成されているかどうか 確認して、質問に書くべきでは。 >PCを入れ替えた際に、が原因で従来なら行われる場所と、今回のファイルの場所が違ってしまい、影響が出ていないのか。   デスクトップに今回の処理でそれらしきファイが出来て居れば、そのファイルが印刷されないことの 原因究明に移るべきでしょう。 PDFファイルという、エクセルのバージョンの進化との関係で、Adobe社との関連で、色々事情があった箇所と関連していると思うが、プリンタ―ドライバーとか、PDFフォーマット作製のソフトのインストールの必要性は余りWEBなどでも説明されていない。 Googleなどで「エクセル pdfファイル 印刷できない」でWEB照会し、該当しそうな記事を読んでやってみてはどうか。

  • HohoPapa
  • ベストアンサー率65% (454/692)
回答No.2

私の環境で行ってみる限り、デスクトップにPDFファイルが作成されます。 コードの実行途中で何やらエラーが起きているものと思いますが、 On Error Resume Next このコードがあるため、発生している(と思われる)ものの、 無視されています。 このコードをコメントアウトすることで エラーの発生を炙り出せるものと思います。

verify
質問者

補足

ご回答ありがとうございました。 コメントアウトしますと、PDF生成のコードが黄色く反転しました。しかし、どうも他の方が指摘くださったように新PCのパスの変数?のようです。

  • NuboChan
  • ベストアンサー率47% (745/1584)
回答No.1

Environ("UserProfile") & "\Desktop" 環境変数を確認してみてください。 イミディエイト ウィンドウでDebug.printして正常でしょうか ?

verify
質問者

補足

ご回答をまことにありがとうございます。 Environ("UserProfile") & "\Desktop\"をEnviron("UserProfile") & "\Desktop"に直したところ、uses直下のフォルダ(C:¥users¥to¥)に”desktoprecept_1.pdfとして出力されました。 ご案内の環境変数は確認してみたのですが、正直よくわかりません。WINDOWS10で使用していましたが、PC移行で11になりました。環境変数というのはOSバージョンごとに異なるのでしょうか。

関連するQ&A

  • エクセルで連続印刷した範囲を印刷済とわかるように

    エクセルで以下のようなプログラムで変数s、eに入力の範囲でシートの連続印刷しております。印刷し終わった後ですが、変数s~eの範囲を赤くして印刷済かどうかをひと目でわかるようにしたいと思います。可能でしょうか。 Sub 範囲を指定して印刷() Dim s As Long Dim e As Long Dim i As Long On Error Resume Next s = InputBox("開始No.を入力して下さい。") If s = 0 Then Exit Sub e = InputBox("終了No.を入力して下さい。") If e = 0 Then Exit Sub For i = s To e Worksheets("A").Range("C1") = i Application.Wait Now + TimeSerial(0, 0, 10) Worksheets("B").PrintOut Next i End Sub

  • VBA どこでもセル選択

    教えて頂いたVBAなのですがもう一つ Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j Counter = Counter + 1 If INP <> "" Then wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub -------------------------------------------------------------- For i = 3 のところを3としないでどのセル(行)にも対応させたいのですが どうすればいいでしょうか?

  • マクロで封筒を自動印刷

    マクロで封筒を自動印刷出来る様にファイルを作りました。 先日、そのマクロで封筒を印刷する前に 別のファイルの物を印刷しようと思い、そのファイルの印刷設定を変えて 印刷をしました。 その後、マクロで作ったファイルで封筒を印刷したところ 印刷設定がおかしくなってしまいました。 とりあえず、設定を直し何度かマクロで印刷を試みましたが いくら直して上書きしても印刷設定が直らず・・・・。 一度、PCを再起動して再び試みると印刷がきちんとされました。 この現象はマクロを使っているからなのでしょうか?? それともマクロの使い方が悪くて起きる症状なのでしょうか? 対策方法があれば教えて頂けるとうれしいです。 使っているマクロは次のとおりです。 Sub Futo_Copy() '////////////////////////////// '印刷を行う '////////////////////////////// Dim i As Integer Dim S_1 As String '1行目 Dim S_2 As String '2行目 Dim S_3 As String '3行目 Dim S_4 As String '4行目 Dim S_5 As String '5行目 Dim S_6 As String '6行目 Dim S_7 As String '7行目 Dim S_8 As String '8行目 Dim S_9 As String '9行目 Dim S_10 As String '10行目 Application.ScreenUpdating = False '描画をしない 'sheet_name = ActiveSheet.Name 'アクティブシート名を取得 'シートの中で使用されている最大の列を求める。 'row_count = Worksheets("印刷対象").Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row 'シートの中で使用されている最大の行を求める。 'col_count = Worksheets("印刷対象").Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column row_count = Worksheets("印刷対象").Range("A65536").End(xlUp).Row For i = 3 To row_count '印刷対象の3行目からループ Worksheets("出力").Select 'データ取得 S_1 = Worksheets("印刷対象").Cells(i, 1) S_2 = Worksheets("印刷対象").Cells(i, 2) S_3 = Worksheets("印刷対象").Cells(i, 3) S_4 = Worksheets("印刷対象").Cells(i, 4) S_5 = Worksheets("印刷対象").Cells(i, 5) S_6 = Worksheets("印刷対象").Cells(i, 6) S_7 = Worksheets("印刷対象").Cells(i, 7) S_8 = Worksheets("印刷対象").Cells(i, 8) S_9 = Worksheets("印刷対象").Cells(i, 9) S_10 = Worksheets("印刷対象").Cells(i, 10) Worksheets("出力").Cells(1, 1) = S_1 Worksheets("出力").Cells(2, 1) = S_2 Worksheets("出力").Cells(3, 1) = S_3 Worksheets("出力").Cells(4, 1) = S_4 'Worksheets("出力").PrintPreview 'プレビュー Worksheets("出力").PrintOut 'プリントアウト Next i 'Worksheets("出力").Cells.Clear 'シートのクリア Application.ScreenUpdating = True '描画開始 Worksheets("印刷対象").Activate End Sub 出来ればこのマクロの形をあまり変えずに 症状が直せるといいのですが・・・。 よろしくお願い致します。

  • VBA 空白表示させたい

    教えて頂いたVBAなのですが Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents If Selection(Selection.Count).Row <> 2 Then Exit Sub Counter = 0 For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j If INP <> "" Then Counter = Counter + 1 wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub ---------------------------------------------------------------------- g      h       i      j パセリ クレソン メキャベツの葉 ごぼう 1      1             1 1                    1 1行目 パセリ,クレソン,メキャベツの葉 2行目  3行目 パセリ,メキャベツの葉 と、2行目は詰めずに空白表示したいです。 どこをどうすればできますか?

  • 検索 マクロ

    本を見ながら作ったのですが 検索してくれるのですが A列を検索してくれるのですが検索したいのは B列の4番目から下にあるだけ検索したいのですが どういじればいいのでしょうか? Option Explicit Private lastRow As Long Private Index As Integer Private Sub UserForm_Activate() Dim i As Long lastRow = Worksheets("顧客情報").Cells(Rows.Count, 1).End(xlUp).Row + 1 If lastRow <= 3 Then MsgBox "データがありません。" Exit Sub End If For i = 3 To lastRow 名前リストボックス.AddItem Cells(i, 1) Next End Sub Private Sub 検索ボタン_Click() Dim searchName As String searchName = 検索名前テキストボックス.Text If searchName = "" Then MsgBox "検索する名前を入力してください。" Else Dim i As Long Dim no As Long For i = 0 To 名前リストボックス.ListCount - 1 If 名前リストボックス.List(i) = searchName Then no = i 名前リストボックス.ListIndex = no Exit For ElseIf i >= 名前リストボックス.ListCount - 1 Then MsgBox "該当なし。" Exit For End If Next Index = no + 3 Rows(Index).Select End If End Sub

  • マクロが上手く組めない

    各シートの特定のセル(1,25)にINDEXシートのハイパーリンクを 設定したいのですが、「オブジェクトが存在しません」 とエラーが表示されてしまっており、どのように修正すればいいのか 分からず、困っております。何故エラーが出たのかについてご教授頂けると幸いです。 私の書いたソースコード ********************************** ********************************** Sub INDEXLINK() Dim w As Worksheet Set w = Sheets("INDEX") Dim i As Long For i = 1 To ActiveWorkbook.Worksheets.Count Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1,25), Address:="", SubAddress:=w & "!c1", TextToDisplay:=w.Name Next End Sub

  • エクセル2007のマクロ、2動作ができない

    Okwaveで教えていただいたマクロを一つのボタンで動かそうとしています。 ステップインで動かすと希望の動作をするのですが実行すると途中で止まります。 点検用紙をコピーして日付と曜日を入れようとしています。 Sub macro1() Dim s As String s = Format(Date, "e年m月") On Error GoTo errhandle Worksheets(s).Select  With Range("A7:D7") Value = Date NumberFormatLocal = "ggge年m月d日" End With With Range("E7") Value = Date NumberFormatLocal = "aaa曜" Select End With Exit Sub errhandle: Worksheets("月次点検用紙").Copy before:=Worksheets(2) ActiveSheet.Name = s End Sub

  • 素数を求めるマクロを

    走らすと暴走したようになり、素数=151で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める()   Dim i As Long   Dim j As Long   Dim m As Long   Dim p As Long   Dim flg As Boolean   i = 1   j = 1   p = 2   Do     flg = False     For m = 2 To Int(Sqr(p))       If p Mod m = 0 Then         flg = True         Exit For       End If     Next     If flg = False Then       Cells(i, j) = p       i = i + 1       If i > Rows.Count Then         i = 1         j = j + 1       End If     End If     p = p + 1   Loop End Sub ======================

  • データ抜き出しマクロについて

    以下のプログラムは10行ごとにデータを抜き出すプログラムです。 これに追加して例えば5結果の変動があったとき、10%結果の変動が あった時にデータを抜き出すようにするにはどうすればいいですか? Sub nukitori() Dim X As Worksheet Dim i As Long Dim ii As Long Dim col As Integer Dim Nukitori_Step As Long Nukitori_Step = 10 i = 2 ii = 2 '●●●見出し行が1行目なので2で始める Set X = ActiveSheet '●シートShordataがあったら削除 On Error Resume Next Application.DisplayAlerts = False Worksheets("shortdata").Delete Application.DisplayAlerts = True On Error GoTo 0 Worksheets.Add.Name = "shortdata" '●先ず、見出しをコピー Worksheets("shortdata").Rows(1).Value = X.Rows(1).Value While X.Cells(i, 1) <> "" And i < 65535 For col = 1 To 255 Worksheets("shortdata").Cells(ii, col).Value = X.Cells(i, col).Value Next If i = 2 Then i = 1 i = i + Nukitori_Step ii = ii + 1 Wend End Sub

  • ほんの少し変更しただけで、マクロが正常動作しないのは?

    「てすと1」はきちんと、結果が反映されるが、 「てすと2」は、動作はするが、肝心のデータがコピーされません。 Range("B5", Range("B5").End(xlDown)) と、変更しただけです。 ただ、「てすと2」は、手動で Worksheets(i)をアクティヴにしておくと、きちんと結果が反映されます。 なぜなんでしょうか? 何卒、ご教授お願い致します。 Sub てすと1() Dim i As Integer   Windows("TEST.xls").Activate   Sheets.Add after:=Worksheets(Worksheets.Count), Count:=1 On Error Resume Next For i = 1 To Worksheets.Count - 1   Worksheets(i).Range("C:C").Copy _   Destination:=Worksheets(Worksheets.Count).Range("IV4").End(xlToLeft).Offset(0, 1).EntireColumn  Next i End Sub Sub てすと2() Dim i As Integer   Windows("TEST.xls").Activate   Sheets.Add after:=Worksheets(Worksheets.Count), Count:=1 On Error Resume Next For i = 1 To Worksheets.Count - 1   'Worksheets(i).Activate  '左記を追記すると、きちんと結果が反映される   Worksheets(i).Range("B5", Range("B5").End(xlDown)).Copy _   Destination:=Worksheets(Worksheets.Count).Range("IV4").End(xlToLeft).Offset(0, 1)  Next i End Sub

専門家に質問してみよう