Excel VBA質問箱 IV

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

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


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

80 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80888】Re:autofilter エラー

Jaka - 19/6/7(金) 16:19 -


	引用なし

	パスワード

数式多くないですか？
ShowAllData を通った後にエラーになるのでしょうか？
　
>　　If ActiveSheet.FilterMode Then
　　　　msgbox "ShowAllData"　　　　　　 ←ここに入れて確認
>　　ActiveSheet.ShowAllData
>　　End If
>　　
>　　＞Range("A1").AutoFilter field:=3, Criteria1:=nodeID

どっちにしろ、このIf分の前に再計算を手動にしてみてはどうでしょうか？
全て終わったら、元に戻すことを忘れずに・・・。

おまけ
フィルターモード解除
Sheets("Sheet1").AutoFilterMode = False

・ツリー全体表示


	【80887】autofilter エラー

初心者 - 19/6/7(金) 7:27 -


	引用なし

	パスワード

Private Sub ComboBox1_Change()
　　
　　Dim CbB1 As String
　　Dim nodeID As Integer
　　Dim x As Long
　　
　　CbB1 = ComboBox1.Value
　　
　　With Worksheets("list")
　　For x = 2 To .Range("b65536").End(xlUp).Row
　　If .Cells(x, 2).Value = CbB1 Then
　　nodeID = .Cells(x, 2).Offset(, -1).Value
　　Exit For
　　End If
　　Next
　　End With
　　
　　Worksheets("sheet1").Activate
　　
　　If ActiveSheet.FilterMode Then
　　ActiveSheet.ShowAllData
　　End If
　　
　　＞Range("A1").AutoFilter field:=3, Criteria1:=nodeID

ここでrangeクラスのautofilterメゾッドが失敗しましたと出ます
しかしautofilter絞り込みはnodeIDの値で絞り込めてます
なのにエラーが出る原因がわかりません
わかる方いたらお願いします！

　　Range("A1").CurrentRegion.Copy Sheets("list").Range("e1")
　　Range("a1").AutoFilter

End Sub

・ツリー全体表示


	【80886】Re:オートシェイプ辺り判定：円と回転す...

γ - 19/6/6(木) 23:04 -


	引用なし

	パスワード

>円と円は三平方で、円と非回転の長方形は１辺との距離判定でクリアしましたが、
>回転となるとわからなくなりました。
長方形の回転角をθとすると、
長方形の中心を回転中心として、両者をｰθ回転すれば、
回転無しの長方形と円との交点判定に帰着できるはずですが。

・ツリー全体表示


	【80885】Re:PDFのプロパティ情報をExcelへ自動入力

マナ - 19/6/6(木) 21:45 -


	引用なし

	パスワード

▼N さん：
>PDFファイルを右クリックした中にあるプロパティの「作成日時」をExcelVBAを使って自動でセルに入力したいのですが、

あくまで「作成日時」だけ、でよいならですが…
ht　tp://officetanaka.net/excel/vba/filesystemobject/file02.htm

　

・ツリー全体表示


	【80884】オートシェイプ辺り判定：円と回転する長...

ＳＨＵＮ - 19/6/6(木) 19:58 -


	引用なし

	パスワード

VBAで作るゲームの質問です。

自分で操作する円形のオートシェイプと、自動で回転する長方形のオートシェイプの
当たり判定はどうすればよいでしょうか？？

円と円は三平方で、円と非回転の長方形は１辺との距離判定でクリアしましたが、
回転となるとわからなくなりました。

よろしくお願いいたします。

ちなみに円と円の衝突は以下のようにつくりました。

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'円の作成
Sub MakeCircle()

Dim p1 As Single, p2 As Single
Dim s1 As Single, s2 As Single
Dim p3 As Single, p4 As Single
Dim s3 As Single, s4 As Single

With Selection
　p1 = 50　 '左端からの位置
　p2 = 200　'上端からの位置
　s1 = 20　 '図形の横幅
　s2 = 20　 '図形の縦幅
　p3 = 200
　p4 = 200
　s3 = 40
　s4 = 40
　
End With

'自機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p1, p2, s1, s2).Name = "circle1"
With ActiveSheet.Shapes("circle1")
　　'図形の背景色青
　　.Fill.ForeColor.RGB = vbBlue
　　'図形の枠線を無しに設定
　　.Line.Visible = False
End With

'敵機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p3, p4, s3, s4).Name = "circle2"
With ActiveSheet.Shapes("circle2")
　　.Fill.ForeColor.RGB = vbRed
　　.Line.Visible = False
End With

End Sub

'円の移動
　Sub MoveCircle()

　Dim crc1 As Object
　Dim crc2 As Object
　
　Dim x1 As Single
　Dim x2 As Single
　Dim y1 As Single
　Dim y2 As Single
　
　Dim rx As Single

　'オブジェクト変数に図形を入れる
　Set crc1 = ActiveSheet.Shapes("circle1")
　Set crc2 = ActiveSheet.Shapes("circle2")

　Do
　
　If GetAsyncKeyState(40) <> 0 Then '下
　　　　If crc1.Top < 300 Then
　　　　crc1.Top = crc1.Top + 10
　　　　Else
　　　　crc1.Top = crc1.Top
　　　　End If
　End If
　
　If GetAsyncKeyState(38) <> 0 Then '上
　　　　If crc1.Top > 40 Then
　　　　crc1.Top = crc1.Top - 10
　　　　Else
　　　　crc1.Top = crc1.Top
　　　　End If
　End If
　
　If GetAsyncKeyState(39) <> 0 Then '右
　　　　If crc1.Left < 300 Then
　　　　crc1.Left = crc1.Left + 10
　　　　Else
　　　　crc1.Left = crc1.Left
　　　　End If
　End If
　
　If GetAsyncKeyState(37) <> 0 Then '左
　　　　If crc1.Left > 40 Then
　　　　crc1.Left = crc1.Left - 10
　　　　Else
　　　　crc1.Left = crc1.Left
　　　　End If
　End If
　　　　
　'1 ～ 4 の乱数を発生
　Randomize
　
　rd = Int(Rnd * 4 + 1)

　'得られた乱数によって敵機ランダム移動
　Select Case rd

　Case 1
　　If crc2.Top < 280 Then
　　crc2.Top = crc2.Top + 20
　　Else
　　crc2.Top = crc2.Top
　　End If

　Case 2
　　If crc2.Top > 40 Then
　　crc2.Top = crc2.Top - 20
　　Else
　　crc2.Top = crc2.Top
　　End If
　　
　Case 3
　　If crc2.Left < 280 Then
　　crc2.Left = crc2.Left + 20
　　Else
　　crc2.Left = crc2.Left
　　End If
　　
　Case Else
　　If crc2.Left > 40 Then
　　crc2.Left = crc2.Left - 20
　　Else
　　crc2.Left = crc2.Left
　　End If

　End Select

　'当たり判定：ゲームオーバー
　x1 = crc1.Left + crc1.Width / 2
　y1 = crc1.Top + crc1.Height / 2
　x2 = crc2.Left + crc2.Width / 2
　y2 = crc2.Top + crc2.Height / 2
　rx = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
　
　　If rx < 30 Then

　　
　　MsgBox "ゲームオーバー"
　　
　　crc1.Delete
　　crc2.Delete
　　
　　
　　Exit Do
　　
　　End If
　
　
　'Enterでゲーム終了

　　If GetAsyncKeyState(13) <> 0 Then
　　　　
　　crc1.Delete
　　crc2.Delete
　　
　　Exit Do
　　
　　End If

　'処理間隔を 0.1 秒に設定
　Application.Wait [Now() + "0:00:00.1"]

　Loop
　

　End Sub

・ツリー全体表示


	【80883】Re:ゲーム制作：自機の操作と敵機の自動...

ＳＨＵＮ - 19/6/6(木) 19:53 -


	引用なし

	パスワード

とても遅れました。
色々四苦八苦した結果、セルの色付けでなく、オートシェイプを動かす術を
身に着けたら解決できました。

ありがとうございます。

・ツリー全体表示


	【80882】Re:PDFのプロパティ情報をExcelへ自動入力

ピンク - 19/6/6(木) 16:59 -


	引用なし

	パスワード

▼N さん：
>Set objAcroPDDoc = CreateObject("AcroExch.PDDoc")←この行で「activexコンポーネントはオブジェクトを作成できません」とエラーになりました。　　

私のPCにはAdobe Acrobat 7.0が入っており
Acrobatの入っていないPCでは上記のエラーが出ました。
Acrobatが入ってないと使えないようですね、失礼しました。m(__)m

・ツリー全体表示


	【80881】Re:PDFのプロパティ情報をExcelへ自動入力

N - 19/6/6(木) 14:52 -


	引用なし

	パスワード

ご回答いただきありがとうございます。
参照設定の一覧にAcrobatがなかったため、
Dim objAcroPDDoc As New　Acrobat.AcroPDDocの代わりに、
Dim objAcroPDDoc As Object
Set objAcroPDDoc = CreateObject("AcroExch.PDDoc")　
を入力しました。実行したところ、
Set objAcroPDDoc = CreateObject("AcroExch.PDDoc")←この行で「activexコンポーネントはオブジェクトを作成できません」とエラーになりました。　　
調べたのですが、分からなかったため、教えていただきたいです。

・ツリー全体表示


	【80880】Re:PDFのプロパティ情報をExcelへ自動入力

ピンク - 19/6/6(木) 14:17 -


	引用なし

	パスワード

▼N さん：
>参照設定が必要な場合はどの項目にチェックを入れればいいでしょうか。
参照設定の一覧に Acrobat か有ればチェック

無ければ
>　　Dim objAcroPDDoc As New　Acrobat.AcroPDDoc
の代わりに
Dim objAcroPDDoc As Object
Set objAcroPDDoc = CreateObject("AcroExch.PDDoc")

・ツリー全体表示


	【80879】Re:フォルダーのコピーを名前を変えて行...

yamasan - 19/6/6(木) 13:44 -


	引用なし

	パスワード

マナさん：
　　　
ありがとうございます！バッチリ出来ました！
とても助かりました^ ^

・ツリー全体表示


	【80878】PDFのプロパティ情報をExcelへ自動入力

N - 19/6/6(木) 12:24 -


	引用なし

	パスワード

PDFファイルを右クリックした中にあるプロパティの「作成日時」をExcelVBAを使って自動でセルに入力したいのですが、下記のように「Dim～」の行で「ユーザ定義型は定義されていません」とエラーがでました。このエラーの解消方法を教えていただけないでしょうか？
参照設定が必要な場合はどの項目にチェックを入れればいいでしょうか。
※PCにAcrobatReaderDCがインストールされています。

Sub 入力()
　　Dim objAcroPDDoc As New　Acrobat.AcroPDDoc（ここで、「ユーザ定義型は定義されていません」と表示されました）
　　　　　　　　　　　　・
　　　　　　　　　　　　・
　　　　　　　　　　　　・
End Sub

・ツリー全体表示


	【80877】エクセルのマクロでiMacrosを動かす

おふじ - 19/6/5(水) 21:47 -


	引用なし

	パスワード

エクセルのマクロでGoogle ChromeのiMacrosを動かすコードはあるのでしょうか？

ご教授お願いいたします。

・ツリー全体表示


	【80876】Re:フォルダーのコピーを名前を変えて行...

マナ - 19/6/5(水) 19:10 -


	引用なし

	パスワード

▼yamasan さん：

　　コピー元 = "C:\Users\哲司\Desktop\foldercopy\a"
　　コピー先 = "C:\Users\哲司\Desktop\foldercopy\b\"
　　
　　For k = 1 To 9999
　　　　tmp = コピー先 & Format(k, "a0000")
　　　　If Not FSO.folderexists(tmp) Then Exit For
　　Next
　　
　　If k < 10000 Then FSO.copyfolder コピー元, tmp

・ツリー全体表示


	【80875】Re:エクセル　userformのイニシャライズ...

のり - 19/6/5(水) 14:13 -


	引用なし

	パスワード

γ様、
書込みありがとうございます。
旅行していたため、返事がおそくなりました。
申し訳ございません。
エラーの件、解決致しました。
userformの開放と挿入を繰り返すと、バグがないのにuserform.showでエラーがでてしまう、という現象でした。
excel　vbaの何らかの不具合だと思われます。
全てのuserformを、エクスポート、削除した後、インポートしたら、
エラーがでなくなりました。

今後とも、よろしくお願い致します。
のり

▼γ さん：
>バグはありません、と断言していますが、
>バグっているから、.Showでエラーになっているものと思料。
>
>オプションのエラートラップは、３つの選択肢がありますが、
>3番目のものに指定していませんか？
>これを、一時的に、最初の
>・エラー発生時に中断
>に変更してみると、実際のエラー箇所が表示されて止まるはずです。
>ただし、これはデバッグ用のものなので、バグ解決後、
>元の選択肢に戻しておいたほうがよいと思います。
>（後半部分は想像です。実際に確認していません。あしからず）

・ツリー全体表示


	【80874】フォルダーのコピーを名前を変えて行いた...

yamasan

- 19/6/5(水) 10:08 -


	引用なし

	パスワード

お世話になります。

フォルダー「a」をフォルダ「b」のサブフォルダにコピーします。その際上書きではなく毎回名前を変えて保存していきたいです。末尾に何かを付けるとか何でもよく、上書きさえしなければいいです。

現在は

----------------------------------------------------

Sub test53()
　　Dim FSO As Object
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　　　
　　
　　FSO.GetFolder("C:\Users\哲司\Desktop\foldercopy\a\").Copy "C:\Users\哲司\Desktop\foldercopy\b\"
　　
　　Set FSO = Nothing
End Sub

----------------------------------------------------

で、単純なコピーのみ出来ております。

よろしくお願いします。

・ツリー全体表示


	【80873】Re:データ摘出

gan134 - 19/6/4(火) 22:10 -


	引用なし

	パスワード

▼マナさん：
>▼gan134 さん：
>
>ここを読んでみてください
>ht tps://kokodane.com/mini_macro26.ht
ありがとうございます。
早い対応で大変たすかりました。
明日手が空いた時にでもしてみます。
また宜しくお願いいたします。

・ツリー全体表示


	【80872】Re:データ摘出

マナ - 19/6/4(火) 22:00 -


	引用なし

	パスワード

▼gan134 さん：

ここを読んでみてください
ht tps://kokodane.com/mini_macro26.htm

・ツリー全体表示


	【80871】Re:データ摘出

gan134 - 19/6/4(火) 21:43 -


	引用なし

	パスワード

▼マナさん：
>▼gan134 さん：
>
>関数で求めておいて
>↓ではだめですか。
>
>With Sheets("sheet2").Range("B5:B7")
>　　.Value = .Value
>End With
早速のご回答ありがとうございます。一度やってみます。
これだけで摘出されてsheet2だけメールで送信してもみれるようになるんですね。これはどういった処理になってるのでしょうか？素人の質問でごめんなさい

・ツリー全体表示


	【80870】Re:データ摘出

マナ - 19/6/4(火) 21:30 -


	引用なし

	パスワード

▼gan134 さん：

関数で求めておいて
↓ではだめですか。

With Sheets("sheet2").Range("B5:B7")
　　.Value = .Value
End With

・ツリー全体表示


	【80869】Re:データ摘出

gan134 - 19/6/4(火) 21:12 -


	引用なし

	パスワード

▼マナさん：
>▼gan134 さん：
>
>>関数でindexとmatch組合てでは出来るのですがそれをVBAでしたいのです。
>
>なぜでしょうか？
報告書をメールでsheet2だけを送りたいのですが、相手側はsheet1のデータはもってないためです。

・ツリー全体表示


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

80 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free