Excel VBA質問箱 IV

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

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


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

79 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80894】Re:教えてください

tomo - 19/6/8(土) 16:45 -


	引用なし

	パスワード

▼マナさん：
>▼tomo さん：
>
>数値ならApplication.InputBoxを使うとよいです。
>ht　tp://officetanaka.net/excel/vba/tips/tips37.htm

早速InputBoxを使い作ってみましたが、コンパイルエラー（7行目）が出てしまいます。何がダメなのでしょうか？

Dim 文字列 As Integer
　　文字列 = InputBox("サイズを入力してください")
　　　 If 80 <= 文字列 And 文字列 <= 100 Then
　　　　　　　　　MsgBox "Bです"
　　　　　　 ElseIf 20 <= 文字列 And 文字列 < 80 Then
　　　　　　　　　　　MsgBox " Dです。"
　　　　　　　　ElseIf 0 < 文字列And 文字列 < 20 Then
　　　　　　　　　　　　 MsgBox " Fです。"
　　　　　　　　　 ElseIf 文字列 = 0 Then
　　　　　　　　　　　　　　MsgBox " 0以外を入力してください。"
　　　　　　　　　　　ElseIf 101 <= 文字列 Then
　　　　　　　　　　　　　　　 MsgBox " 101以上になっています。"

　　　　　　　　ElseIf文字列 = False Then
　　　　　　　　　MsgBox "キャンセルします。"

End Sub

・ツリー全体表示


	【80893】Re:教えてください

マナ - 19/6/8(土) 14:53 -


	引用なし

	パスワード

▼tomo さん：

数値ならApplication.InputBoxを使うとよいです。
ht　tp://officetanaka.net/excel/vba/tips/tips37.htm

・ツリー全体表示


	【80892】Re:教えてください

Jaka - 19/6/8(土) 14:51 -


	引用なし

	パスワード

こんな感じ？？

Dim a As Variant
a = Application.InputBox("サイズを入力してください", Type:=1)
If VarType(a) = vbBoolean Then
　 MsgBox "cancel"
Else
　 MsgBox a
End If

・ツリー全体表示


	【80891】教えてください

tomo - 19/6/8(土) 14:25 -


	引用なし

	パスワード

点数で区分けをしたいのですが、メッセージボックスに何も入力しないでokをした時　”型が一致しません”　のエラーが出てしまいます。
以下のどこが間違っているのでしょうか？
どなたか教えていただけないでしょうか。
よろしくお願いいたします。
　　
Dim inScore As Integer
　inScore = InputBox("サイズを入力してください")
　　　 If 80 <= inScore And inScore <= 100 Then
　　　　　　　　　MsgBox "Bです"
　　　　　　 ElseIf 20 <= inScore And inScore < 80 Then
　　　　　　　　　　　MsgBox " Dです。"
　　　　　　　　ElseIf 0 < inScore And inScore < 20 Then
　　　　　　　　　　　　 MsgBox " Fです。"
　　　　　　　　　 ElseIf inScore = 0 Then
　　　　　　　　　　　　　　MsgBox " 0以外を入力してください。"
　　　　　　　　　　　ElseIf 101 <= inScore Then
　　　　　　　　　　　　　　　 MsgBox " 101以上になっています。"
　　　　　　　　　　　　 ElseIf inScore = "　" Then
　　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　 MsgBox " 空白になっています。"
　　　　　　　　
　　　 End If
　　End Sub

・ツリー全体表示


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

N - 19/6/7(金) 21:52 -


	引用なし

	パスワード

皆様、ご回答いただき本当にありがとうございました。
心の底から感謝しています。

・ツリー全体表示


	【80889】Re:autofilter エラー

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


	引用なし

	パスワード

▼Jaka さん：
>数式多くないですか？
>ShowAllData を通った後にエラーになるのでしょうか？
>　
>>　　If ActiveSheet.FilterMode Then
>　　　　msgbox "ShowAllData"　　　　　　 ←ここに入れて確認
>>　　ActiveSheet.ShowAllData
>>　　End If
>>　　
>>　　＞Range("A1").AutoFilter field:=3, Criteria1:=nodeID
>
>どっちにしろ、このIf分の前に再計算を手動にしてみてはどうでしょうか？
>全て終わったら、元に戻すことを忘れずに・・・。
>
>おまけ
>フィルターモード解除
>Sheets("Sheet1").AutoFilterMode = False

showalldataを通ってautofilterはnodeIDの値で掛かっているのに
エラーが出てしまいます
アドバイスありがとうございます
再計算を手動にしてみる件　検討中です

・ツリー全体表示


	【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番目のものに指定していませんか？
>これを、一時的に、最初の
>・エラー発生時に中断
>に変更してみると、実際のエラー箇所が表示されて止まるはずです。
>ただし、これはデバッグ用のものなので、バグ解決後、
>元の選択肢に戻しておいたほうがよいと思います。
>（後半部分は想像です。実際に確認していません。あしからず）

・ツリー全体表示


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

79 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free