Excel VBA質問箱 IV

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

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


1 / 3724 ページ 前へ→

【80116】Re:フルパスの受け渡し
発言[NEW]  マナ  - 18/8/17(金) 21:18 -

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

>下記のコードで、画像ファイルのフルパスをセルに書き出さずに
>フルパスを受け取りたいのですが、どのように直せば良いか教えて下さい。

> Dim FileType As String

を、プロシージャの外にだせばよいのではありませんか。

あるいは、いったんセルに書き出すとしても、
フルパスを受け取ったあとで、最後にクリアするとか。
・ツリー全体表示

【80115】フルパスの受け渡し
質問[NEW]  Image  - 18/8/17(金) 19:39 -

引用なし
パスワード
   フォーム上のイメージコントロールに画像を表示し、
その画像で良ければ、OKボタンを押してセルに張付けたい。

下記のコードで、画像ファイルのフルパスをセルに書き出さずに
フルパスを受け取りたいのですが、どのように直せば良いか教えて下さい。


以下、コード。

画像をファイルから選択し、Image1に表示。----------------------------------------------------
Sub CommandButton1_Click

 Dim FileType As String
 Dim Dialog As String
 Dim Filename As Variant

 FileType = "画像ファイル (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png," _
      & "JPEG 形式 (*.jpg),*.jpg," _
      & "GIF 形式 (*.gif),*.gif," _
      & "PNG 形式 (*.png),*.png"

 Dialog = "画像ファイルの選択"
 Filename = Application.GetOpenFilename(FileType, , Dialog)

 If Filename <> False Then
  Image1.Picture = LoadPicture(Filename)
 Else
  Image1.Picture = LoadPicture("")
 End If

End Sub

Image1の画像で良ければ、セルに貼付け。------------------------------------------------------

CommandButton2_Click

 Dim Filename As Variant
 Dim Shape As Variant
 Dim MovCell As Range
 Dim MovLeft As Double
 Dim MovTop As Double
 Dim MovHeight As Double
 Dim MovWidth As Double

 If Filename <> False Then
  For Each Shape In Worksheets("Sheet1").DrawingObjects
   If Not Intersect(Shape.TopLeftCell, Worksheets("Sheet1"). _
            Range("F10:I21")) Is Nothing Then
    Shape.Delete
   End If
  Next

  Worksheets("Sheet1").Range("F10:I21").Value = Dir(Filename)
  
  With Worksheets("Sheet1").Range("F10:I21")
   MovLeft = .Left
   MovTop = .Top
   MovHeight = .Cells(.Count).Offset(1).Top - .Top
   MovWidth = .Cells(.Count).Offset(, 1).Left - .Left
  End With

  With Worksheets("Sheet1").Shapes.AddPicture(Filename:=Filename, LinkToFile:=False, _
                        SaveWithDocument:=True, Left:=Selection.Left, _
                        Top:=Selection.Top, Width:=0, Height:=0)
  End With

  With Worksheets("Sheet1").Pictures(Worksheets("Sheet1").Pictures.Count).ShapeRange
   .LockAspectRatio = msoFalse
   .Parent.Visible = msoTrue
   .Left = MovLeft
   .Top = MovTop
   .Height = MovHeight
   .Width = MovWidth
   .Line.Visible = msoTrue
   .Line.Style = msoLineSingle
   .Line.ForeColor.RGB = RGB(0, 0, 0)
   .Line.Weight = 1.5
   .Name = Dir(Filename)
  End With

 Else
  For Each Shape In Worksheets("Sheet1").DrawingObjects
   If Not Intersect(Shape.TopLeftCell, Worksheets("Sheet1"). _
            Range("F10:I21")) Is Nothing Then
    End
   End If
  Next

  Worksheets("Sheet1").Range("F10:I21").Value = "ファイルが選択されていません。"

 End If
・ツリー全体表示

【80114】Re:特定セル範囲のダブルクリックマクロ
発言[NEW]  マナ  - 18/8/17(金) 19:02 -

引用なし
パスワード
   ▼猫の毛だらけ さん:

>Dim myTarget As Range

↑は不要です。

'-----

"good"でも"error"でも、Cancelするなら
最後または最初に、Cancel = True を記述すればよいです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 If Not Application.Intersect(Target, Range("A1:C1")) Is Nothing Then
   MsgBox "good"
 Else
   MsgBox "error" 
 End If

 Cancel = True

End Sub

'-----


>Set myTarget = Application.Intersect(Target, Range("A1:C1"))
> If myTarget Is Nothing Then
   Exit Sub
> End If

↑最初の質問文のコードのように、
A1:A3以外のときは、なにもしないで終了し
通常のダブルクリック処理をしたいなら、


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 If Application.Intersect(Target, Range("A1:C1")) Is Nothing Then
  Exit Sub
 End If
 
 Cancel = True
 'A1:C3をダブルクリックで実行することを以下に記述
 MsgBox "good"

End Sub

'-----
 
> Else:

↑の:は不要です。

>Else: MsgBox "error"

↑は、1行で記述しているので必要だっただけです。
・ツリー全体表示

【80113】Re:特定セル範囲のダブルクリックマクロ
お礼[NEW]  猫の毛だらけ  - 18/8/16(木) 23:20 -

引用なし
パスワード
   マナ様
ご指摘ありがとうございました。

下記のように修正しました。
Cancel = Trueの意味が分からず、記述場所も?でしたが
イベントのキャンセル(=今回はダブルクリック後のセルの編集状態解除)
と考えてよろしいでしょうか?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myTarget As Range

 If Not Application.Intersect(Target, Range("A1:C1")) Is Nothing Then
   MsgBox "good"
   Cancel = True
  
 Else:
   MsgBox "error"
   Cancel = True
 End If
 
End Sub
・ツリー全体表示

【80112】Re:特定セル範囲のダブルクリックマクロ
発言[NEW]  マナ  - 18/8/16(木) 18:31 -

引用なし
パスワード
   ▼猫の毛だらけ さん:

> myC = Split(Selection.Address, "$")(1) '列アルファベット選択

間違いではありませんが、Targetを使えばよいと思います。
myC = Split(Target.Address, "$")(1)

ただ、myC も myR も必要ないのに、なぜ?
myTargetについても、

If Application.Intersect(Target, Range("A1:C1")) Is Nothing Then

とすれば変数を使わなくてもよいです。

あと、必要に応じて
Cancel=True
を追加するとよいと思いました。


 
・ツリー全体表示

【80111】Re:エクセル上からアクセルファイルに読...
お礼[NEW]  みかん  - 18/8/16(木) 17:40 -

引用なし
パスワード
   よろずやさん

ありがとうございます。

ADOではパスワードを付けて保存する方法はなく、DAOのみ方法があるが、
事前に参照設定の必要がある。ってことですね。

たすかりました。ありがとうございました。
・ツリー全体表示

【80110】Re:特定セル範囲のダブルクリックマクロ
発言[NEW]  猫の毛だらけ  - 18/8/16(木) 13:56 -

引用なし
パスワード
   マナ様
ご指摘ありがとうございます。
下記のように書き換えてみました。

矛盾点があればお教えください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myTarget As Range
Dim myC As String, myR As Long
myC = Split(Selection.Address, "$")(1) '列アルファベット選択
myR = 1

Set myTarget = Application.Intersect(Target, Range("A1:C1"))
 If myTarget Is Nothing Then
   MsgBox "error"
 Else:
   MsgBox "good"
 End If
End Sub
・ツリー全体表示

【80109】Re:特定セル範囲のダブルクリックマクロ
発言[NEW]  マナ  - 18/8/16(木) 13:05 -

引用なし
パスワード
   ▼猫の毛だらけ さん:

それで納得できたのですか?

>ブレークポイントを置いて
> If Target.Address =
>にカーソルを持っていくと"$A$1"とか表示されても
>実際には対応していないのですね。

そうではなくて、カーソルは、右辺のmyCにあてて確認してください。

>Dim myC As String, myR As String
>myC = Selection.Column

Stringではなく Longです

>セルA1、B1、C1のどれかをダブルクリックすると
>goodのメッセージが表示されるようにコードを書いたつもりですが

そういうことであれば、

>If myTarget Is Nothing Then

Nothingでなければ goodでよいのでは?
・ツリー全体表示

【80108】Re:特定セル範囲のダブルクリックマクロ
お礼[NEW]  猫の毛だらけ  - 18/8/16(木) 11:49 -

引用なし
パスワード
   ああ,なるほど。

ブレークポイントを置いて
If Target.Address =
にカーソルを持っていくと"$A$1"とか表示されても
実際には対応していないのですね。

ありがとうございました。
・ツリー全体表示

【80107】Re:特定セル範囲のダブルクリックマクロ
回答[NEW]  γ  - 18/8/16(木) 11:31 -

引用なし
パスワード
   冒頭にブレークポイントを置いてステップ実行してみてください。
myCは数値ですよ。("A"とか"C"が返るわけではありません)
"$" & myC & "$" & myR ではマッチしませんね。

Target.Row と Target.Columnで判定してはどうですか?
・ツリー全体表示

【80106】特定セル範囲のダブルクリックマクロ
質問[NEW]  猫の毛だらけ  - 18/8/16(木) 10:28 -

引用なし
パスワード
   いつも拝見させていただいています。
セルA1、B1、C1のどれかをダブルクリックすると
goodのメッセージが表示されるようにコードを書いたつもりですが
errorしか表示されません。
どこがいけないのかお教えください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myTarget As Range
Dim myC As String, myR As String
myC = Selection.Column '列選択
myR = 1

Set myTarget = Application.Intersect(Target, Range("A1:C1"))
 If myTarget Is Nothing Then
   Exit Sub
 End If
 
 If Target.Address = "$" & myC & "$" & myR Then
   MsgBox "good"
  Else: MsgBox "error"
 End If
 
End Sub
・ツリー全体表示

【80105】Re:エクセル上からアクセルファイルに読...
回答  よろずや  - 18/8/15(水) 14:50 -

引用なし
パスワード
   こちらをどうぞ。

ht tps://msdn.microsoft.com/ja-jp/library/cc377103.aspx
・ツリー全体表示

【80104】エクセル上からアクセルファイルに読み取...
質問  みかん  - 18/8/15(水) 0:26 -

引用なし
パスワード
   こんにちは。みかんと申します。

エクセル上から指定したアクセスファイルにパスワードをかけて保存するVBAの記述がわかれば教えていただきたいです。よろしくお願いします。

アクセスファイルにパスワードをかけるには排他モードで開いてから
パスワードをかけることはわかりましたが、パスワードを付けて保存するという
ところのコードが解りません。

Sub acccespass()

Dim accApp As Object

Set accApp = CreateObject("Access.Application")
accApp.Visible = True

accApp.OpenCurrentDatabase "C:\Users\mikan\Desktop\S01.accdb", True, False

↑排他モードでは開ける

ここのパスワードをつけて保存
このコードが解りません。
accApp.Password = "pass"
はダメでした。。。。


accApp.Quit
Set accApp = Nothing

End Sub


よろしくお願いします。
・ツリー全体表示

【80103】Re:右ダブルクリックした際に今日の日付...
お礼  ヒロポン  - 18/8/12(日) 23:36 -

引用なし
パスワード
   やりたい事ができました。
これからはストレスなく入力できます、本当にありがとうございました。
・ツリー全体表示

【80102】Re:右ダブルクリックした際に今日の日付...
発言  γ  - 18/8/12(日) 22:00 -

引用なし
パスワード
   横から失礼します。

既に指摘があるように、
ExcelVBAには右ダブルクリックというイベントプロシージャーは無いので、
どうしても右ダブルクリックで無いと困るというなら、
「マウス 左右反転」などで検索して、
左右を反転する設定にするより無いです。
・ツリー全体表示

【80101】Re:右ダブルクリックした際に今日の日付...
発言  マナ  - 18/8/12(日) 20:22 -

引用なし
パスワード
   ▼ヒロポン さん:

>右クリックでは実行できないんでしょか?
>希望としてどの場所のセルを右ダブルクリックしても実行できる様にはできないのでしょうか?

右クリック?
右ダブルクリック?

どんなイベントプロシージャが用意されているか確認して
使えそうなものを選ぶとよいです。
ht tp://home.att.ne.jp/zeta/gen/excel/c04p59.htm
・ツリー全体表示

【80100】Re:右ダブルクリックした際に今日の日付...
お礼  ヒロポン  - 18/8/12(日) 15:08 -

引用なし
パスワード
   回答ありがとうございます。
実行はできましたが、
右クリックでは実行できないんでしょか?

希望としてどの場所のセルを右ダブルクリックしても実行できる様にはできないのでしょうか?
・ツリー全体表示

【80099】Re:右ダブルクリックした際に今日の日付...
発言  マナ  - 18/8/12(日) 13:15 -

引用なし
パスワード
   ▼ヒロポン さん:

A列を左ダブルクリックしたときに実行さされます。
(ウインドウ枠固定でA列が常時表示されている前提)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column > 1 Then Exit Sub
  Cancel = True
  Application.Goto Cells(1, Day(Date) + 1)
End Sub
・ツリー全体表示

【80098】右ダブルクリックした際に今日の日付行(...
質問  ヒロポン  - 18/8/12(日) 12:24 -

引用なし
パスワード
   A1 2018        
A2 8          B2=DATE($A$1,$A$2,1)  C2=IF(B2>=$A$3,"",B2+1)
A3 =EOMONTH(B2,0)   B3=TEXT(B2,"aaa")    C3=TEXT(C2,"aaa")
A4 朝食 1000円    2000円
A5 昼食 2000円     3000円
A6 夕食 3000円    4000円

この表で食費を入力しているのですが毎日入力している訳ではなく1週間に1回ぐらいの頻度で入力しております、
その為アクティブのセルを探す所から始まりそれが毎回の事なのでストレスに感じます。
その為右ダブルクリックすると本日の日付行(2行目)のセルが選択されると楽に入力出来助かります。
VBAは全くの初心者です。
・ツリー全体表示

【80097】Re:計算式によるクロス集計方法について
発言  γ  - 18/8/12(日) 9:38 -

引用なし
パスワード
   ポイントは、
・「レポートのレイアウト」 を「表形式」にすること
・ code  name  unitの各フィールドの小計をなしにすること
でしょうか。

合計 / quantity                    
            201801 201802 201803 総計
ABCD01 A01  dozen  10   20       30
ABCD02 A02  kg   70           70
ABCD03 A03  Cs           50   50
総計          80   20   50   150

といった結果が得られます。(行、列の小計をなくすことも可能です)
色々な形式が可能ですから、再トライされるとよいでしょう。

ちなみに、こちらはVBA質問箱(Excel)なので、
基本的にはVBAの質問ということになりますね。
・ツリー全体表示

1 / 3724 ページ 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free