Excel VBA質問箱 IV

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

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


108 / 3841 ページ ←次へ | 前へ→

【80308】マクロ作成
質問  kimi  - 19/1/21(月) 11:18 -

引用なし
パスワード
   エクセルのデータでマクロの作成に行き詰っています。

一つの品番で5行使うデータです。
D列に上からP,P(),EX,E,Iとあり、”I”という文字が入っている行を見つけ、D列に計算式を入れたいのです。
最終行は条件によって異なるため指定できません。
データのスタートは必ず3行目からになります。
データが終わるまで5行サイクルで”I”という文字が入っている状況です。

何かいい方法があれば教えてください。
・ツリー全体表示

【80307】Re:フォルダを作成し、さらにファイル名...
発言  you  - 19/1/19(土) 21:33 -

引用なし
パスワード
   マナさん

いえ、手動で行ったところ、あのメッセージが出ました・・
環境の問題なのでしょうか・・
・ツリー全体表示

【80306】Re:シートを範囲してPDF出力
発言  マナ  - 19/1/18(金) 21:15 -

引用なし
パスワード
   ▼FUKUDA さん:

>ActiveWorkbookだから、ブック全体が対象になっているのではありませんか。

で、選択したシートのみを対象にするには、どうしたらよいか。
まずは、手作業で試して、そのあと「マクロの記録」です。
・ツリー全体表示

【80305】Re:シートを範囲してPDF出力
発言  マナ  - 19/1/18(金) 18:25 -

引用なし
パスワード
   ▼FUKUDA さん:

>ところがIF分の場合分け通りにメッセージボックスが表示されているのにもかかわらず出力されるPDFデータはどちらの場合でも3シートとも出力されてしまいます。


>ActiveWorkbook.ExportAsFixedFormat

ActiveWorkbookだから、ブック全体が対象になっているのではありませんか。
・ツリー全体表示

【80304】Re:フォルダを作成し、さらにファイル名...
発言  マナ  - 19/1/18(金) 18:20 -

引用なし
パスワード
   ▼you さん:

問題ないようにみえます。
手動では、保存できるのでしょうか。
・ツリー全体表示

【80303】シートを範囲してPDF出力
質問  FUKUDA  - 19/1/18(金) 10:45 -

引用なし
パスワード
   初めて利用させていただきます。

現在仕事で使用する書類のフォーマットを作成しており、提出方法をエクセル機能によるPDF出力に統一させたいため、マクロボタンで簡便にできるよう試行錯誤しておりました。

エクセルブックにシートが3つあり、IFの場合分けで出力範囲を指定する
ことを目標としており、各所調べて以下のようなプログラムを作成しました。

ところがIF分の場合分け通りにメッセージボックスが表示されているのにもかかわらず出力されるPDFデータはどちらの場合でも3シートとも出力されてしまいます。

PrintPreviewでフローを確認すると正常にシートが選択されているようなのですが、PDF出力にしたとたん上記のようになってしまします。

どなたか原因がわかる方がいらっしゃいましたらご教授いただけると幸いです。

鎧市区お願いいたします。


〜〜以下プログラム〜〜

Sub Pictureserch()

  Dim PictureCount
  Dim rc As VbMsgBoxResult
  Dim currentFolderPath As String
  Dim fileName As String
  Dim savePath As String
  
  currentFolderPath = ActiveWorkbook.Path

  fileName = Range("D3") & Range("E3") & "_" & Range("D4").Value & ".pdf"

  savePath = currentFolderPath & "\" & fileName

PictureCount = Worksheets("写真").Pictures.Count

  If PictureCount > 0 Then
   
   rc = MsgBox("写真シート内に写真データがあります写真シートも含めてPDF出力しますか?", vbYesNo + vbQuestion)
   
   If rc = vbYes Then
   
   MsgBox "PDFデータを本エクセルデータと同じフォルダに出力します。", vbInformation
   
   Worksheets.Select
   'ActiveWorkbook.PrintPreview
   ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=savePath '選択したシートをPDF出力
   
   Else
   
   MsgBox "処理を中止します", vbCritical
   
   End If

Else

    rc = MsgBox("写真シート内に写真データがありません写真シートを除いてPDF出力しますか?", vbYesNo + vbQuestion)
   
    If rc = vbYes Then
   
   MsgBox "PDFデータを本エクセルデータと同じフォルダに出力します。", vbInformation
   
    Worksheets(Array("カルテ", "対応一覧")).Select
    'ActiveWorkbook.PrintPreview
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=savePath '選択したシートをPDF出力
   
   Else
   
   MsgBox "処理を中止します", vbCritical
   
   End If

  End If


End Sub
・ツリー全体表示

【80302】Re:フォルダを作成し、さらにファイル名...
発言  you  - 19/1/17(木) 23:07 -

引用なし
パスワード
   マナさん

ありがとうございます。
初心者なのでかなり苦労しています。
お手数かけてすいません。

Sub test()
Dim SaveDir As String
 
SaveDir = Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分")

MkDir "\\ここに保存したいです\" & SaveDir

ActiveWorkbook.SaveAs"\\ここに保存したいです\" & SaveDir _
& "\" & SaveDir & "_売上.xls"_
,FileFormat:=xlExcel8,CreateBackup:=False

End Sub

これで試すと、
「実行時エラー:1004 SaveAsメソッドは失敗しました。Workbookオブジェクト」
となってしまいました・・。
・ツリー全体表示

【80301】Re:フォルダを作成し、さらにファイル名...
発言  マナ  - 19/1/16(水) 18:32 -

引用なし
パスワード
   ▼you さん:

>う〜ん・・よく分からないです。

最終的にどんな文字列にする必要があるか理解できていますか。
理解できていれば、あとは試行錯誤でなんとかなります。

Sub test()
  Dim SaveDir As String
  
  SaveDir = Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分")
  MsgBox SaveDir
  
  '保存場所
  MsgBox "\\ここに保存したいです\" & SaveDir
  '保存ファイル名
  MsgBox SaveDir & "_売上.xls"
  
  MsgBox "\\ここに保存したいです\" & SaveDir _
      & "\" & SaveDir & "_売上.xls"
  
End Sub
・ツリー全体表示

【80300】Re:フォルダを作成し、さらにファイル名...
質問  you  - 19/1/15(火) 20:17 -

引用なし
パスワード
   SaveDir="\\ここに保存したいです\"&
Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分\")&
Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分_売上")&".xls"_
,FileFormat:=xlExcel8,CreateBackup:=False

これで試してみたのですが、やはりフォルダは出来ているのですが、
フォルダと同じ階層に2018年10月分2018年_10月分_売上のファイル名で出来てしまいました・・。
フォルダに格納したいのですが・・。

う〜ん・・よく分からないです。
・ツリー全体表示

【80299】Re:フォルダを作成し、さらにファイル名...
発言  you  - 19/1/12(土) 19:32 -

引用なし
パスワード
   マナさん

>>SaveDir="\\ここに保存したいです\"&
>>Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分"\)&
>>Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分_売上")&".xls"_
>>,FileFormat:=xlExcel8,CreateBackup:=False
>>
>>End Sub

ご指摘ありがとうございます。
こういうことでしょうか?
すいません、現在officeが使える環境でないので、
試せるのが火曜日になってしまいます。

初心者で申し訳ありませんがよろしくお願いします。
・ツリー全体表示

【80298】Re:フォルダを作成し、さらにファイル名...
発言  マナ  - 19/1/12(土) 13:39 -

引用なし
パスワード
   ▼you さん:

>(3)
>SaveDir="\\ここに保存したいです\"&
>Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分")&
>Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分_売上")&".xls"_
>,FileFormat:=xlExcel8,CreateBackup:=False
>
>End Sub

>しかもファイル名が2018年10月分_2018年10月分_売上という変なファイル名になってしまいます・・。
>

フォルダ名とファイル名の間に、区切りの \ が抜けていませんか?
・ツリー全体表示

【80297】Re:フォルダを作成し、さらにファイル名...
質問  you  - 19/1/12(土) 12:03 -

引用なし
パスワード
   参照したURLを元にさっそく試してみました。

Sub Test

(1)
SaveDir="\\ここに保存したいです\"&
Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分")

(2)
If Dir(SaveDir, vbDirectory)="" Then
  Mkdir SaveDir
End If

(3)
SaveDir="\\ここに保存したいです\"&
Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分")&
Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分_売上")&".xls"_
,FileFormat:=xlExcel8,CreateBackup:=False

End Sub

質問。
(1)と(2)で3か月前のフォルダが作れるのは問題なかったのですが、本来は(3)で
「2018年_10月分_売上」というファイル名のデータをこのフォルダに格納したいのですが、上手くいきません。しかもファイル名が2018年10月分_2018年10月分_売上という変なファイル名になってしまいます・・。

お手数ですが、ご教授願います。
・ツリー全体表示

【80296】Re:フォルダを作成し、さらにファイル名...
お礼  you  - 19/1/10(木) 22:22 -

引用なし
パスワード
   マナさん

おぉ、さっそくありがとうございます。
今、officeが使える環境ではないので、
明日さっそく試してみます。
また何かありましたら質問させていただきます。
・ツリー全体表示

【80295】Re:フォルダを作成し、さらにファイル名...
発言  マナ  - 19/1/10(木) 18:56 -

引用なし
パスワード
   ▼you さん:

2)
Sub test()
  MsgBox Format(WorksheetFunction.EDate(Date, -3), "yyyy年_m月分_売上")
End Sub

3)
保存先フォルダが存在しない場合はフォルダを作成してブックを保存する
ht tps://www.moug.net/tech/exvba/0060035.html
・ツリー全体表示

【80294】フォルダを作成し、さらにファイル名をつ...
質問  you  - 19/1/10(木) 11:15 -

引用なし
パスワード
   コードがあるのですが、これを改変したいです。

ActiveWorkbook.SaveAs"\\ここに保存したいです\20〇〇年_"&_
Format(DateAdd("m",-3,Date),"m")&"月分_売上"&".xls"_
,FileFormat:=xlExcel8,CreateBackup:=False

やりたいこと↓
1:ファイル名の月の部分を3か月前にしたい(済み)

2:20〇〇年のところを今から3か月前のものに沿った年にしたいです。今月だったら2018年10月になるわけです。2019年にならないようにしたいです。(仮に今年の10月に保存したら2019年7月になるようにしたいです)(未処理)

3:フォルダをこの階層に作り、上記で作成したファイルを格納したいです。フォルダ名は「20〇〇年_×月分_売上」(×の部分は今より3か月前、〇はそれに沿った年)(未処理)

上記の2と3に詰まってしまいました。
どなたか知恵を貸していただけると助かります。
・ツリー全体表示

【80293】Re:画像貼り付け
発言  マナ  - 19/1/5(土) 20:28 -

引用なし
パスワード
   ▼インザーギ さん:
>画像貼り付けを目的とし、コードを見やすくすることを目標に作成しています。

1)貼り付けできるようにしてからがよいのでは。
まずは、1つの画像を目的の位置、サイズで貼付けることから。

2)プロシージャを分けて、わかりにくくなっているのでは。
この程度なら1つにしたほうがわかりやすいかも。
・ツリー全体表示

【80292】画像貼り付け
質問  インザーギ  - 19/1/5(土) 17:38 -

引用なし
パスワード
   画像貼り付けを目的とし、コードを見やすくすることを目標に作成しています。
ネットから参照しながら作成していましたが、行き詰ってしまったため
ご教授をお願いますでしょうか。


1.ダイアログから任意のフォルダを開きます。
2.サブフォルダ内の指定したjpegファイルを格納します。
3.シートにjpegファイルを貼り付けます。
4.貼り付けるシートには、B列にフォルダ単位で貼り付けたい。
5.同じサブフォルダ内に複数の指定したjpegが有る場合は、4.で貼り付けた
行のC列以降に貼り付けたい。
6.A行には、サブフォルダ名を入力


Option Explicit
Dim FSO As Scripting.FileSystemObject
Dim pfl As Folder
Dim mySubfld(), myfname() As Variant
Dim i, j As Integer

Sub ユーザーにフォルダーを選択してもらう()
  Call mysubfolder
  
End Sub

Public Function mysubfolder()

  Dim dlg As FileDialog
  Dim fold_path As String
  Set FSO = New Scripting.FileSystemObject
  Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

  ' キャンセルボタンクリック時にマクロを終了
  If dlg.Show = False Then Exit Function

  ' フォルダーのフルパスを変数に格納
  fold_path = dlg.SelectedItems(1)
 
  Dim folderName As String
  Dim buf As Folder
  Dim fold As String
  
  i = 1
  
  With FSO
  Set pfl = .GetFolder(fold_path)
  For Each buf In pfl.SubFolders ' サブフォルダの一覧を取得
    ReDim mySubfld(i)
    mySubfld(i) = buf.Name
    Call ファイル取得(fold)
    Call 画像貼り付け(j)
    i = i + 1
  Next
  End With
  
End Function

Public Function ファイル取得(ByRef fold As String)
  Dim tmpfile As Variant
  fold = pfl & "\" & mySubfld(i)
  MsgBox fold
  
  ChDir pfl & "\" & mySubfld(i)
  tmpfile = Dir("BackResult" & "*.jpg")
  If FSO.FileExists(tmpfile) Then
  
  End If
  j = 1
  Do While tmpfile <> ""
    ReDim myfname(j)
    myfname(j) = tmpfile
    Call 画像貼り付け(j)
    tmpfile = Dir()
    j = j + 1
  Loop

End Function


Public Function 画像貼り付け(ByRef j As Integer)
  Dim objshape As Shape
  Dim myCell As Range
  Dim tmp As Object
  For i = 2 To UBound(myfname) + 1
    Set myCell = Cells(i + j)
    myCell.Select
    Set objshape = ActiveSheet.Shapes.AddPicture( _
      Filename:=myfname(j), _
      linktofile:=False, _
      savewithdocument:=True, _
      Left:=Selection.Left, _
      Top:=Selection.Top, _
      Width:=0, _
      Height:=0)  
  Next i
End Function
・ツリー全体表示

【80291】Re:VBAで項目ごとの集計について
発言  γ  - 19/1/3(木) 17:56 -

引用なし
パスワード
   複数のところで議論する必要はありません。
こちらは閉じて「学校」で継続して下さい。
・ツリー全体表示

【80290】Re:VBAで項目ごとの集計について
お礼  VBA勉強中  - 19/1/3(木) 17:40 -

引用なし
パスワード
   γ さん

基本方針を確認しておりませんでした。申し訳ありません。
もう少し自分で実行してから、再度質問させていただきます。
・ツリー全体表示

【80289】Re:奇数行にて処理する方法
お礼  galikun  - 19/1/3(木) 16:46 -

引用なし
パスワード
   マナ さん
 ありがとうございました。 ヒントになりました。

Private Sub CommandButton1_Click()
    If ActiveCell.Row Mod 2 = 1 Then
     MsgBox "奇数時の処理を実行させる"
 
  Else
     MsgBox "偶数時の処理を実行させる"
  End If

End Sub

以上のように入力して、テストとしては成功しました。
後で、実際の処理に必要なプログラムを挿入します。
ありがとうございました。
・ツリー全体表示

108 / 3841 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free