Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

109 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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 さん：

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

３）
保存先フォルダが存在しない場合はフォルダを作成してブックを保存する
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

やりたいこと↓
１：ファイル名の月の部分を3か月前にしたい（済み）

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

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

上記の２と３に詰まってしまいました。
どなたか知恵を貸していただけると助かります。

・ツリー全体表示


	【80293】Re:画像貼り付け

マナ - 19/1/5(土) 20:28 -


	引用なし

	パスワード

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

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

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

・ツリー全体表示


	【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

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

・ツリー全体表示


	【80288】Re:奇数行にて処理する方法

マナ - 19/1/3(木) 15:18 -


	引用なし

	パスワード

▼galikun さん：

Sub test()
　　MsgBox Range("A1").Row Mod 2 = 1
　　MsgBox Range("A2").Row Mod 2 = 1
　　MsgBox Range("A3").Row Mod 2 = 1
　　MsgBox Range("A4").Row Mod 2 = 1
End Sub

・ツリー全体表示


	【80287】奇数行にて処理する方法

galikun - 19/1/3(木) 14:35 -


	引用なし

	パスワード

任意の行が偶数行であるか、奇数行であるかを判定して処理を実行したいです。

If 任意の行が奇数行である　then
　　Range("A1").value=1　'処理の本来の中身はあとで入力します。
else
　　Range("A1").value=2　　'処理の本来の中身はあとで入力します。
　　Range("A2").value="偶数"
Endif

『任意の行が奇数行である』の部分を知りたいと思っています。
よろしくお願いします。

・ツリー全体表示


	【80286】Re:VBAで項目ごとの集計について

γ - 19/1/3(木) 11:05 -


	引用なし

	パスワード

基本方針より。
>しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出し
>ました」ということを宣言してください。そして、仮に他のサイトで解決したの
>なら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモ
>ラルに反します。「解決したからいいや」というのではありません。

それほど色々な所に質問しても無駄です。
このテーマではどこもほとんど同じ答えです。
それに貴方は上記のような手間を掛けたいですか？

・ツリー全体表示


	【80285】VBAで項目ごとの集計について

VBA勉強中 - 19/1/3(木) 8:51 -


	引用なし

	パスワード

VBAを使用して項目ごとの集計方法について、ご教授を宜しくお願いします。

下記の様なA列「注文日」、B列「品名」、C列「発送日」リストがあります。
これを集計結果にあるような集計をしたいのですが、どの様な方法がありますでしょうか？
ピボットテーブルでは出来るのですが、VBAを使用して作業を簡略化させたいと考えております。

　　 A列　　　　　B列　　　　　 C列
　　注文日　　　品名　　　　　発送日
2018/1/1 10:00　みかん　　2018/1/5 10:00　
2018/1/2 10:00　　　　リンゴ　　2018/1/5 10:00
2018/1/3 10:00　　　　バナナ
2018/1/4 10:00　　　　みかん　　2018/1/5 10:00
2018/2/1 10:00　みかん
2018/2/2 10:00　　　　リンゴ　　2018/2/5 10:00
2018/2/3 10:00　　　　バナナ　　2018/2/5 10:00
2018/2/4 10:00　　　　みかん　　2018/2/5 10:00

＜集計結果＞

A列　　　　B列　　　 C列　　　　D列　　　　 E列
注文月　　品名　　注文回数　発送回数　　発送率
2018/1　　みかん　　　2　　　　　2　　　　　　100%
2018/1　　リンゴ　　　1 　　　　 1　　　　 100%
2018/1　　バナナ　　　1　　　　　0　　　　　 0%
2018/2　　みかん　　　2　　　　　1　　　　　50%
2018/2　　リンゴ　　　1 　　　　 1　　　　 100%
2018/2　　バナナ　　　1　　　　　0　　　　　 0%

・ツリー全体表示


	【80284】Re:グラフ対数表示

やす - 18/12/28(金) 20:59 -


	引用なし

	パスワード

▼マナさん：

>ActiveChart.SetElement (msoElementPrimaryCategoryAxisShow)

↑でできました！
とても助かりました、ありがとうございました！

・ツリー全体表示


	【80283】Re:グラフ対数表示

マナ - 18/12/28(金) 19:09 -


	引用なし

	パスワード

▼やすさん：

>とすると、y軸で第2軸を使用していると以下のエラーが発生します。
>　'ScaleType"メソッドは失敗しました：'Axis'オブジェクト
>

検索してみたら、2007以降のバグのようです。

ht　tps://stackoverflow.com/questions/27140463/excel-vba-chart-axis-error-method-scaletype-of-object-axis-failed-when-re

>以下のように記述すれば第2軸を使用していても対数表示できるのですが、
>逆に線形に戻す記述がわからず困っています。
>
> ActiveChart.SetElement (msoElementPrimaryCategoryAxisLogScale)
>

これは、違いますか？

でActiveChart.SetElement (msoElementPrimaryCategoryAxisShow)

　

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

109 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free