目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

┃ ┃一覧表示 ┃ ┃ ┃ ┃

7 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

【169】Re:テロップ

りん

- 06/12/25(月) 12:53 -


	引用なし

	パスワード

マキチャンさん、こんにちわ。
Jaka さんもこんにちわ。

>Sub AAA()
> 　Dim I As Long
>
> For I = 1 To 10
>
>　Sheets("SHEET1").Cells(3, 3) = ("シ")
>　　Sleep 200
＜＜略＞＞
>　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！！")
>　　Sleep 200
>
>　Next I
>
>End Sub

似た文が多いので、まとめたらこんな感じかな。
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub TEST()
　 Dim II As Integer, LL As Integer, AA As String
　 AA = "シート　内容に注意！！" 'メッセージ内容
　 '
　 For II = 1 To 10
　　　For LL = 1 To Len(AA) '文字数
　　　　 ActiveSheet.Cells(3, 3).Value = Left(AA, LL)
　　　　 Sleep 200
　　　Next LL
　 Next II
End Sub

・ツリー全体表示

【168】Re:ちょっと気になる現象3　プロパティの参...

ichinose - 06/12/24(日) 12:32 -


	引用なし

	パスワード

どうやら、参照渡しのパラメータとして、
オブジェクトのプロパティを直接指定した場合、
自動的に値渡しに変更されているようです。

　　Call addcalc(a, b, Me.ans)

でMeキーワードを付加してしまうと、ただの変数ではなく、
オブジェクト（Workbook）のプロパティと認識されてしまいます。

値渡しでパラメータが渡されるので
サブプロシジャー（addcalc）内で変数の値を変更しても
呼び出し元の変数（ans）には値の変更の影響がありません。

よって、「2 + 3 = 0」と表示されてしまいます。

このような場合は、第3変数をパラメータとして使用し、

戻り値をプロパティに設定する方法が考えられますね。

Sub main2()
　　Dim a As Long
　　Dim b As Long
　　Dim c As Long
　　Me.ans = 0
　　a = 2
　　b = 3
　　Call addcalc(a, b, c)
　　Me.ans = c
　　MsgBox a & " + " & b & " = " & Me.ans
End Sub

問題はこれで解決します（解決方法は簡単なのですが）。

因みにThisworkbookのモジュールに

'===============================================================
Public ans As Variant
'===============================================================
Sub main()
　　Dim a As Long
　　Dim b As Long
　　ans = 0
　　a = 2
　　b = 3
　　Call addcalc(a, b, ans)
　　MsgBox a & " + " & b & " = " & ans
End Sub
'================================================================
Sub addcalc(x As Long, y As Long, z As Long)
　　z = x + y
End Sub

これで、Thisworkbook.mainを実行すると、
実行前のコンパイル時のエラーで
「Byref引数の型が一致しない」というエラーが発生します。

上記のmainの

Call addcalc(a, b, ans)

を

Call addcalc(a, b, me.ans)

に変更すると、

正しい結果は返してくれませんが、エラーにはなりませんでした。

これは、値渡しのパラメータでは、
型のチェックがコンパイル時には行われていないことを意味します。

まっ、「値が受け継がれさえすればよいのですから、そこまでは必要がない」

ということでしょうか？

尚、Vbscriptとでもプロパティを参照渡しでは、渡すことが出来ませんでした。

確認したコードは以下のとおりです。下記のコードをテキストファイルとして保存し、

保存後拡張子をvbsに変更して実行してみてください（例　Test.vbs）

'===================================
dim a,b
dim zzz
dim cc
set cc=new cls
a=2
b=3
cc.bbb=0
call test(a,b,cc.bbb)
msgbox a & " + " & b & " = " & cc.bbb
call test(a,b,zzz)
msgbox a & " + " & b & " = " & zzz
'==================================
sub test(x,y,z)
　 z=x+y
end sub
'==================================
class cls
　 property get bbb()
　　　bbb=zzz
　end property
　property let bbb(dat)
　　 zzz=dat
　end property
end class

・ツリー全体表示

【167】ちょっと気になる現象3　プロパティの参照...

ichinose - 06/12/24(日) 12:29 -


	引用なし

	パスワード

サブプロシジャーへのパラメータの渡し方には、参照渡しと値渡しがあることは
知られていることですよね！！

新規ブックのThisWorkbookのモジュールに、

'==================================================================
Option Explicit
Public ans As Long
'==================================================================
Sub main()
　　Dim a As Long
　　Dim b As Long
　　ans = 0
　　a = 2
　　b = 3
　　Call addcalc(a, b, ans)
　　MsgBox a & " + " & b & " = " & ans
End Sub
'==================================================================
Sub addcalc(x As Long, y As Long, z As Long)
　　z = x + y
End Sub

として、ThisWorkbook.mainを実行すると、
「2 + 3 = 5」と正しく足し算の答えが表示されますが、

上記のmainを

'==================================================================
Sub main()
　　Dim a As Long
　　Dim b As Long
　　Me.ans = 0
　　a = 2
　　b = 3
　　Call addcalc(a, b, Me.ans)
　　MsgBox a & " + " & b & " = " & Me.ans
End Sub

のように「変数ansにMeキーワードを付ける」という変更を行ってから、
mainを実行すると、

「2 + 3 = 0」と正しく足し算の答えが表示されません。

不思議ではないですか？

・ツリー全体表示

【166】Re:テロップ

マキチャン - 06/12/23(土) 22:54 -


	引用なし

	パスワード

▼Jaka さん：　こんにちは
　たまたま、掲示板を見ていて、テロップのような動きをさせる方法がわかり、
　メモさせていただきました。すばらしいです。
　私は、まったくのVBA初心者です。ただ、文字を表示させることくらいはできるので、
　以前、同じようなことを考え、初心者なりに、実現はできました。
　今回、テロップ流れ1_セル版とほぼ、同じ動きが、そのとき考えた
　こんなダサい方法でもできます。
Sub AAA()
　Dim I As Long

For I = 1 To 10

　Sheets("SHEET1").Cells(3, 3) = ("シ")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シー")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容")
　 Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！")
　　Sleep 200
　Sheets("SHEET1").Cells(3, 3) = ("シート　内容に注意！！")
　　Sleep 200

　Next I

End Sub

この場合、表示セルの、書式にて、横の配置を右づめにしておきます。
すると右から左へ文字が流れていくように見えます。
また、表示セルの左のセルに何か文字を入力しておき、
文字を白くしておけば、あふれた場合に、消えていくように見えます。
何の参考にもなりませんが、達人の方と同じ動きを実現できていたので
少しうれしくて、投稿してしまいました。すみません。
もちろん、今後は、教えていただいた方法で、やっていきたいと思っています。

・ツリー全体表示

【165】Re:ちょっと気になる現象２　Ｉｓ演算子

ichinose - 06/12/23(土) 22:30 -


	引用なし

	パスワード

ＶＢＡを長くやられている方は、既にお分かりだと思います。

私は、VBAをやり始めて一年ぐらいは理由が分かりませんでした。

Range("A1") Is Range("A1")　の結果が　Falseになるのは、

Range("A1")という記述が実行される度に

Rangeオブジェクトは別インスタンスが作られているからなのです。

よって、
Range("A1") Is Range("A1")
は別々のオブジェクトを比較しているので　Falseとなるのです。

Range("a1").value=Range("a1").value

この記述では、ふたつのインスタンスが作成され、Valueプロパティの
代入処理を行っています。

With Range("A1")
　 .Value=.Value
　 End With

尚、このように記述すると、インスタンスはひとつしか作成されていません。

Shapeでの結果も同じ理由です。

実際に見えているセル　＝　Rangeオブジェクト
実際に見えている図形　＝　Shapeオブジェクト

というように錯覚しがちですが（私は、最初はそう解釈していました）、

Rangeオブジェクトは、セルを操作する窓口であり、

Shapeオブジェクトは、図形を操作する窓口にすぎません。

ひとつのセル、ひとつの図形に対して、
複数の窓口を存在させる事が出来るのです。

同じ図形を見ていても、違う窓口(オブジェクト)であれば、

Is演算子は、Falseを返します。

・ツリー全体表示

【164】ちょっと気になる現象２　Ｉｓ演算子

ichinose - 06/12/23(土) 22:25 -


	引用なし

	パスワード

Is演算子は、オブジェクトを比較する演算子ですが・・・。

新規ブックの標準モジュールに

'==================================================================
Sub main()
　　Dim a As Object
　　Dim b As Object
　　MsgBox "まず" & vbCrLf & _
　　　　　 "Application Is Application = " & _
　　　　　 (Application Is Application)
　　
　　MsgBox "次に" & vbCrLf & _
　　　　　 "ThisWorkbook Is ThisWorkbook = " & _
　　　　　 (ThisWorkbook Is ThisWorkbook)

　　MsgBox "さらに" & vbCrLf & _
　　　　　 "ActiveSheet Is ActiveSheet = " & _
　　　　　 (ActiveSheet Is ActiveSheet)
　　MsgBox "と、ここまではコードと照らし合わせても" & vbCrLf & _
　　　　　 "なんてことはないのですが・・・"
'
'
'
　　MsgBox "ここからが問題現象" & vbCrLf & vbCrLf & _
　　　　　 "Range(""a1"") Is Range(""a1"") = " & _
　　　　　 (Range("a1") Is Range("a1")) & vbCrLf & "あれ？"
　　Set a = Range("a1")
　　Set b = Range("a1")
　　MsgBox "これも" & vbCrLf & _
　　　　　 "Dim a As Object,b As Object" & vbCrLf & _
　　　　　 "Set a = Range(""a1"")" & vbCrLf & _
　　　　　 "Set b = Range(""a1"")" & vbCrLf & _
　　　　　 "a Is b = " & (a Is b) & vbCrLf & _
　　　　　 "あらら・・"
　　With ActiveSheet
　　　 On Error Resume Next
　　　 .Shapes("Rect1").Delete
　　　 On Error GoTo 0
　　　 With .Shapes.AddShape(msoShapeRectangle, [b10].Left, [b10].Top, _
　　　　　　　　　　　　　　[b10].Width, [b10].Height)
　　　　　.Name = "Rect1"
　　　　　.Select
　　　　　End With
　　　 DoEvents
　　　 MsgBox "With .Shapes.AddShape(msoShapeRectangle, [b10].Left, [b10].Top, _" & vbCrLf & _
　　　　　　　"　　　　　　　　　　 [b10].Width, [b10].Height)" & vbCrLf & _
　　　　　　　"　　.Name = ""Rect1""" & vbCrLf & _
　　　　　　　"　　.Select" & vbCrLf & _
　　　　　　　"　　End With" & vbCrLf & vbCrLf & _
　　　　　　　"で、Rect1という四角形を作成しましたが・・・"
　　　 MsgBox "Shapes(""Rect1"") Is Shapes(""Rect1"") = " & _
　　　　　　　(.Shapes("Rect1") Is .Shapes("Rect1")) & vbCrLf & _
　　　　　　　"これもFalse"
　　　 End With
End Sub

上記のコードを実行してみて下さい。

Application Is Application

や

ThisWorkbook Is ThisWorkbook

は、予想通りTrueとなるのに、

Range(“A1”) Is Range(“A1”)

や

Shapes(“Rect1”) Is Shapes(“Rect1”)

は、Falseになってしまいます。

不思議ではないですか？

・ツリー全体表示

【163】Re:ちょっと気になる現象1　演算優先順位

ichinose - 06/12/23(土) 19:51 -


	引用なし

	パスワード

どうやら、ＶＢＡとＥｘｃｅｌの数式での演算の優先順位が違うみたいです。

ＶＢＡでは、

べき乗が－符号より優先されますが、Excelの数式では、－符号が優先されるようです。

しかし、算数では、-2＾2＝-4　と習いましたよね？？

今度は、

'===========================================================
Sub test3()
　　MsgBox "1-2^2 = " & 1 - 2 ^ 2
　　MsgBox "[1-2^2] = " & [1-2^2]
End Sub

これを実行すると、

1 - 2 ^ 2　も　[1-2^2]　も　-3　という結果が表示されます。

[1-2^2]は、1+4=5では　と思うのですが・・・。

結論として、演算優先順位に曖昧な箇所があるので

明示的に（）ではっきり指示する癖を付けておくと、
思わぬ計算違いに合わなくて済みそうですよ！！

Sub test4()
　　MsgBox "[(-2)^2] = " & [(-2) ^ 2]
End Sub

とこのように・・・。

因みにWindowsなら簡単に確認できるVbscriptで

msgbox -2^2

この上記のコードを実行させたら　どんな結果になると思いますか？

確認していただければ、一目瞭然ですが、結果は、「4」でした。

意外です・・よね？

・ツリー全体表示

【162】ちょっと気になる現象1　演算優先順位

ichinose - 06/12/23(土) 19:50 -


	引用なし

	パスワード

新規ブックの標準モジュールに

'==========================================================
Sub test1()
　　MsgBox "-2^2 = " & -2 ^ 2
End Sub

上記のtest1を実行した場合、

-2＾2　=　-4

と表示されます。

では、

'=========================================================
Sub test2()
　　MsgBox "[-2^2] = " & [-2 ^ 2]
End Sub

このtest2を実行すると、

[-2^2]　=　4

と表示されてしまいます。
[-2^2]の結果は、セルに入力した数式「=-2 ^ 2」の値と同値です。

不思議ではないですか？

・ツリー全体表示

【161】条件付書式版

Jaka - 06/11/2(木) 11:44 -


	引用なし

	パスワード

●条件付書式版１（作業セルが必要。）
　作業セルをＡ１として、

標準モジュール

Public savad As String

Sub Auto_Open()　　　　　　　↓対象シート名と同じ
　　If ActiveSheet.Name = "Sheet1" Then
　　　 savad = ActiveCell.Address
　　End If
End Sub

対象シートモジュール

Private PrevCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　'If Target.Count > 1 Then Exit Sub
　　If Range("A1").Value = "" Then
　　　 Range("A1").Value = ActiveCell.Address(0, 0)
　　End If
　　If Not PrevCell Is Nothing Then
　　　 Range("A1").Value = ActiveCell.Address(0, 0)
　　　 On Error Resume Next
　　　 PrevCell.FormatConditions.Delete
　　　 On Error GoTo 0
　　　 With ActiveCell
　　　　　 .FormatConditions.Delete
　　　　　 .FormatConditions.Add Type:=xlExpression, Formula1:="=A1=""" & .Address(0, 0) & """"
　　　　　 .FormatConditions(1).Interior.ColorIndex = 3
　　　 End With
　　End If
　　Set PrevCell = ActiveCell 'Target.Cells(1)
　　DoEvents
End Sub

Private Sub Worksheet_Activate()
　　savad = ActiveCell.Address
End Sub

●条件付書式版２（やっぱり作業セルが必要。）
　作業セルをＡ１として、各セルに条件付書式を設定しておく。
　簡易だけど、ファイルが重くなる可能性大。
　↓これにひっかかる可能性がありそう
　"表示形式を追加できません"エラーが書式設定時に発生する
　えっちttp://support.microsoft.com/default.aspx?scid=kb%3bja%3b213904

シートモジュール

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Range("A1").Value = Target.Address
End Sub

全てのセルか、Ａ１から使いたい範囲のセルを選択して、

条件付書式の「数式が」で、
=CELL("address",A1)=$A$1
（A1の条件は後で消す。）

----------------
ちょっとした発見
入力規則って、セルに設定しただけでは、UsedRange内に入らないんですね。
範囲内に入るのは、リストから何かしらの値が選択されたときだけで、
セルを選択して、Deleteキー等でセル内容を消すと、また範囲外になるんですね。

また、条件付書式も範囲外として扱われるんですね。
今まで、てっきり対象になると思ってました。

・ツリー全体表示

【160】オートフィルタ解除とずべて表示

Jaka - 06/10/31(火) 11:41 -


	引用なし

	パスワード

１、オートフィルターを解除する

Sub オートフィルタ解除()
　　'Sheets("Sheet1").AutoFilterMode = False
　　ActiveSheet.AutoFilterMode = False
End Sub

２、オートフィルターを全て表示にする。
　　オートフィルタで、抽出状態の物があれば、全オートフィルタを全表示にする。
　　（１つも抽出状態で無いのに、全表示にするとエラーになる。）

Sub オートフィルター全表示()
　　If ActiveSheet.FilterMode = True Then
　　　 ActiveSheet.ShowAllData
　　End If
End Su

３、オートフィルタ部分的に全表示にする。

・セルまたは、列を選択指定する。
　選択したセルの列のオートフィルタを「全て表示」にする。
　（尚、複数列選択に対しては、対応してません。左右の一方からしか順に調べられない。）

Sub 選択部分全表示()
　 Dim ColC As Range, ColNo As Integer
　 If ActiveSheet.FilterMode = False Then Exit Sub
　 With ActiveSheet.AutoFilter
　　　For i = 1 To .Filters.Count
　　　　 If .Filters.Item(i).On Then
　　　　　　ColNo = .Range.Cells(i).EntireColumn.Column
　　　　　　Set ColC = Application.Intersect(Selection, Columns(ColNo))
　　　　　　If Not ColC Is Nothing Then
　　　　　　　 MsgBox "フィルター範囲 " & i & " 列目解除" & vbLf & _
　　　　　　　　　　　Chr(.Range.Cells(1).Column + i + 63) & " 列"
　　　　　　　　　　　 '↑テスト用確認の為、Z列までがまともに表示される。AA列以降は未対応。
　　　　　　　 .Range.Cells(1).AutoFilter Field:=i
　　　　　　　 Set ColC = Nothing
　　　　　　　 '↓フィルタされた順番はわかりません。コメントにして複数に対応させるときは注意。
　　　　　　　 Exit Sub
　　　　　　End If
　　　　 End If
　　　Next
　 End With
End Sub

・フィルタ範囲列指定する。
　オートフィルタ範囲の３列目を「全表示」にする。

Sub 部分全表示()
　 If ActiveSheet.FilterMode = False Then Exit Sub
　 Rtu = 3
　 ActiveSheet.AutoFilter.Range.Cells(1).AutoFilter Field:=Rtu
End Sub

・ツリー全体表示

【159】アクティブセルの視認性アップ

Jaka - 06/10/31(火) 10:18 -


	引用なし

	パスワード

アクティブセルの色が「赤」に変わります。範囲選択の場合でもアクティブセルのみ対象。
色月セルを選択したまま終了すると、選択前の色情報を保存してないから、セル移動後は色が無い物として扱う。（無色にされる。）
セルのアクティブセル認識色と同色の色に変えた場合、無色にされる。選択する前から赤の場合はそのままです。
不具合も色々あると思いますから、参考程度に。
条件付書式を使ってもいいんだけど....。

注）セルの色を変えているから、セルの使用履歴に反映されます。
　　つまり、UsedRangeが拡大します。

**************
標準モジュール

Public savad As String

Sub Auto_Open()
　　　　　　　　　　　　　 '↓ 対象シート名
　　If ActiveSheet.Name = "Sheet1" Then
　　　 savad = ActiveCell.Address
　　End If
End Sub

**************
シートモジュール（上記コードの対象シート名と同じシート）

Private OrgColor As Integer
Private PrevCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　If Not PrevCell Is Nothing Then
　　On Error Resume Next
　　If PrevCell.Interior.ColorIndex <> xlNone Then
　　　 If PrevCell.Interior.ColorIndex <> 3 Then
　　　　　'irono = PrevCell.Interior.ColorIndex
　　　　　'PrevCell.Interior.ColorIndex = irono
　　　 Else
　　　　　PrevCell.Interior.ColorIndex = OrgColor
　　　 End If
　　End If
　　On Error GoTo 0
　Else
　　On Error Resume Next
　　Range(savad).Interior.ColorIndex = xlNone
　　On Error GoTo 0
　End If
　OrgColor = ActiveCell.Interior.ColorIndex
　ActiveCell.Interior.ColorIndex = 3
　Set PrevCell = ActiveCell
End Sub

Private Sub Worksheet_Activate()
　　savad = ActiveCell.Address
End Sub

・ツリー全体表示

【157】シート上、フォームのコンボボックス使用例

Jaka - 06/10/26(木) 9:55 -


	引用なし

	パスワード

シート上に表示　→　ツールバー　フォーム　のコンボボックスがあるとして、名前は、「ドロップ 1」「ドロップ 2」の場合。１、 ListFillRangeを使用（セル参照）コンボボックス右クリック　→　コントロールの書式設定　→ コントロール　→　入力範囲の場合、 Sub コンボ初期設定() 　　ActiveSheet.Shapes("ドロップ 1").OLEFormat.Object.ListFillRange = "Sheet2!A10:A15" End Sub Sub コンボクリア() 　　ActiveSheet.Shapes("ドロップ 1").OLEFormat.Object.ListFillRange = Clear End Sub 作ったコンボボックスに下記マクロをマクロ登録（２、と共通で使用できます。） Sub コンボチェンジ() 　　CBXNm = Application.Caller 　　With ActiveSheet.Shapes(CBXNm).OLEFormat.Object 　　　　No = .ListIndex 　　　　MsgBox No & " 番目" & vbLf & vbLf & _ 　　　　　　　.List(No) 　　End With End Sub ２、 ListFillRangeを使わない方法（配列仕様） Sub コンボ初期設定配列() 　　Dim ListTb As Variant 　　'ListTb = Array("A1", 5, "A3", "A4", "A5") 　　'　　　　　　　　　　 ↑　数値が入るとだめ。　　'　　　　　　　　　　 ↓　文字ならＯＫ。　　ListTb = Array("A1", "5", "A3", "A4", "A5") 　　ActiveSheet.Shapes("ドロップ 1").OLEFormat.Object.List = ListTb 　　Erase ListTb End Sub Sub コンボクリア() 　　ActiveSheet.Shapes("ドロップ 2").OLEFormat.Object.List = vbNullString End Sub マクロ登録するコンボチェンジマクロは、１と同じ。

・ツリー全体表示

【156】Excel2000で、日付関数をFindメソッドで検...

Jaka - 06/10/23(月) 10:41 -


	引用なし

	パスワード

=DATE(2006,10,23)
2000以前のエクセルだと、こんな感じ等の日付をエクセル関数で表示させたセルは、Findメソッドで検索できませんが、2002だと検索できるようになった見たいです。
検索文字が日付の書式と同じという条件がつきますが....。

Sub Macro1()
　　Range("A1").Select
　　Dim RR As Range
　　Set RR = Cells.Find(What:="2006/10/23", After:=ActiveCell, LookIn:=xlValues, _
　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False)
　　If Not RR Is Nothing Then
　　　 RR.Activate
　　Else
　　　 MsgBox "無し"
　　End If
End Sub

EXcel97の場合は、アメリカ方式にすると検索できたようです。
検索文字　　"10/23/06"　（ワイルドカードも確か使えたような記憶が）
セルの書式　2006/10/23 の場合だけ

エクセル2000の場合は、いずれの方法でも検索できませんでしたが、2002で作ったファイルを2000で開いた時に、これ使えるんじゃないかと思って試したらしっかり使えました。
検索文字が日付の書式と同じという条件がつく所は同じですが、
表示形式を
yyyy/m/d;@　　検索文字　"2006/10/23"
ge.m.d;@　　　検索文字　"H18.10.23"
こんな風にするだけです。
;@を後につけても、日付として処理はできるようでした。
現在、97が無いので97でも通用するかはわかりません。

・ツリー全体表示

【155】図を取得するダイアログボックスの表示

深澤　繁

- 06/9/19(火) 23:29 -


	引用なし

	パスワード

プログラムの中で「図の挿入」のダイアログをプログラムの中で表示し
図のパス・ファイル名を取得したいのですが。

Application.GetOpenFilename
は分かっていますが、一般のファイル名の取得なので
図だけの取得ダイアログを出したいのです。

よろしくお願いします。

・ツリー全体表示

【154】InStrRev関数

Red - 06/9/9(土) 3:00 -


	引用なし

	パスワード

'========================================================================================= ' '　InStrRev関数(ある文字列 (string1) の中から指定された文字列 (string2) を最後の文字位置 '　　　　　　　から検索を開始し、最初に見つかった文字位置 (先頭からその位置までの文字数) '　　　　　　　を返す文字列処理関数です。) ' '----------------------------------------------------------------------------------------- '指定項目　　説明 'stringcheck 必ず指定します｡検索先の文字列式を指定します｡ 'stringmatch 必ず指定します｡検索する文字列式を指定します｡ 'start　　　省略可能です。各検索の開始位置を設定する数式を指定します。 '　　　　　　引数 start を省略すると -1 が使用され、最後の文字位置から検索を開始します。 '　　　　　　引数 start に Null 値が含まれると、エラーになります。 'compare　　省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を '　　　　　　指定します。引数 compare を省略すると、バイナリモードで比較が行われます。 '　　　　　　設定する値については、次の「設定値」を参照してください。 ' '引数 compare の設定値は次のとおりです。 ' '定数値説明 'VbUseCompareOption　 -1　 Option Compare ステートメントの設定を使用して比較を行います。 'vbBinaryCompare　　　 0　バイナリモードで比較を行います。 'vbTextCompare　　　　 1　テキストモードで比較を行います。 '========================================================================================= Public Function InStrRev _ 　　　　(StringCheck As String, StringMatch As String, Optional Start As Long = -1, _ 　　　　Optional Compare As VbCompareMethod = vbBinaryCompare) As Long 　　　　 Dim Pos As Long Dim StrChk As String '--　戻り値初期化　-- 　　InStrRev = 0 　　StrChk = Left(StringCheck, IIf(Start = -1, Len(StringCheck), Start)) 　　 '--　引数確認　-- 　　Select Case True 　　Case Start > Len(StrChk) 　　　　Exit Function 　　Case StringCheck = "" 　　　　Exit Function 　　Case StringMatch = "" 　　　　InStrRev = Len(StrChk): Exit Function 　　End Select '--　戻り値の文字位置取得　-- 　　Do 　　　　Pos = InStr(InStrRev + 1, StrChk, StringMatch, Compare) 　　　　If Pos > 0 Then InStrRev = Pos 　　Loop Until Pos = 0 End Function

・ツリー全体表示

【153】Split関数

Red - 06/9/9(土) 2:58 -


	引用なし

	パスワード

'========================================================================================= ' '　Split関数(各要素ごとに区切られた文字列から1次元配列を作成し、返します。) ' '----------------------------------------------------------------------------------------- '指定項目　　説明 'expression　必ず指定します。文字列と区切り文字を含んだ文字列式を指定します。 '　　　　　　引数 expression が長さ 0 の文字列 ("") である場合、Split関数は、要素も '　　　　　　データもない空の配列を返します。 'delimiter　省略可能です。文字列の区切りを識別する文字を指定します。 '　　　　　　引数 delimiter を省略すると、区切り文字にスペース (" ") が使用されます。 '　　　　　　引数 delimiter が長さ 0 の文字列 ("") である場合は、引数 expression 全体の '　　　　　　文字列を含む単一の要素の配列を返します。 'limit　　　省略可能です。返す配列の要素数を指定します。-1 を指定すると、すべての文字列を '　　　　　　含んだ配列を返します。 'compare　　省略可能です。文字列式を評価するときに使用する文字列比較のモードを表す数値を '　　　　　　指定します。設定する値については、次の「設定値」を参照してください。 ' '引数 compare の設定値は次のとおりです。 ' '定数値説明 'VbUseCompareOption　 -1　 Option Compare ステートメントの設定を使用して比較を行います。 'vbBinaryCompare　　　 0　バイナリモードで比較を行います。 'vbTextCompare　　　　 1　テキストモードで比較を行います。 '========================================================================================= Public Function Split _ 　　　　(Expression As String, Optional Delimiter, Optional ByVal Limit As Long = -1, _ 　　　　Optional Compare As VbCompareMethod = vbBinaryCompare) 　　　　 '--　変数の設定　-- Dim Result() As String Dim Pos As Long Dim Start As Long Dim DelimStr As String '--　戻り値初期化　-- 　　Split = Array() '空の配列を生成します。　　 '--　引数確認　-- 　　If Expression = "" Then Exit Function 　　If Limit = 0 Then Exit Function 　　 '--　初期設定　-- 　　DelimStr = IIf(IsMissing(Delimiter), " ", Delimiter) 　　ReDim Result(0) 　　Start = 1 　　Pos = IIf(DelimStr = "", 0, InStr(Start, Expression, DelimStr, Compare)) 　　 '--　配列要素の設定　-- 　　Do Until Pos = 0 　　　　If UBound(Result) = Limit - 1 Then Exit Do 　　　　Result(UBound(Result)) = Mid$(Expression, Start, Pos - Start) 　　　　ReDim Preserve Result(UBound(Result) + 1) 　　　　Start = Pos + Len(DelimStr) 　　　　Pos = InStr(Start, Expression, DelimStr, Compare) 　　Loop 　　 '--　配列最終要素の設定　-- 　　Result(UBound(Result)) = Mid$(Expression, Start) 　　Split = Result 　　Erase Result 　　 End Function

・ツリー全体表示

【152】97で2000以降に追加された関数を使う

Red - 06/9/9(土) 2:55 -


	引用なし

	パスワード

Split関数やInStrRev関数など、
｢97にはない便利な関数と同等の処理が可能な、97で使える関数を組み合わせて
作った自作関数｣
を考えてみませんか？

あらかじめこういうものを作っておけば、｢97の人は目安箱を参照｣とすることで、
質問者のバージョンを気にする必要もなくなりますし、考え方(アルゴリズム)や
コーディングのテクニックの勉強にもなると思い、議題として取り上げてみました。

ExcelだけじゃなくAccessでも使えるかな？

・ツリー全体表示

【151】Re:浮動小数点型の内部形式

ichinose - 06/7/31(月) 14:06 -


	引用なし

	パスワード

新規ブックの標準モジュールに

'=====================================================================
Sub main()
　　Dim cnvnum As Variant
　　Dim csinstr As String
　　Dim cdblstr As String
　　cnvnum = Application.InputBox("数字を入力してください", "単精度・倍精度浮動小数点構造", , , , , , 1)
　　If cnvnum <> "Boolean" Then
　　　 With ActiveSheet
　　　　　With .Range("a:a")
　　　　　　 .ColumnWidth = 40
　　　　　　 .HorizontalAlignment = xlCenter
　　　　　　 End With
　　　　　With .Range("b:b")
　　　　　　 .ColumnWidth = 10
　　　　　　 .HorizontalAlignment = xlCenter
　　　　　　 End With
　　　　　　
　　　　　With .Range("c:c")
　　　　　　 .ColumnWidth = 40
　　　　　　 .HorizontalAlignment = xlCenter
　　　　　　 End With
　　　　　With .Range("d:d")
　　　　　　 .ColumnWidth = 100
　　　　　　 .HorizontalAlignment = xlLeft
　　　　　　 End With
　　　　　With .Range("a1:e1")
　　　　　　 .HorizontalAlignment = xlLeft
　　　　　　 .MergeCells = True
　　　　　　 .Value = "単精度浮動小数点型"
　　　　　　 .Font.Size = 14
　　　　　　 .HorizontalAlignment = xlLeft
　　　　　　 .Interior.ColorIndex = 34
　　　　　　 End With
　　　　　.Range("a2:e2").Value = Array("説明", "符号", "指数部", "仮数部", "ヘキサイメージ")
　　　　　.Range("d2").HorizontalAlignment = xlCenter
　　　　　.Range("e2").HorizontalAlignment = xlCenter

　　　　　csinstr = floating_point(cnvnum, 0)
　　　　　.Range("a3").Value = "'値----　" & cnvnum
　　　　　.Range("b3").Value = "'" & Mid(hextobin(Mid(csinstr, 1, 1)), 1, 1)
　　　　　.Range("c3").Value = "'" & Mid(hextobin(Mid(csinstr, 1, 1)), 2, 3) & "　" & hextobin(Mid(csinstr, 2, 1)) & _
　　　　　　　　　　　　　　　　　　　　 "　" & Mid(hextobin(Mid(csinstr, 3, 1)), 1, 1)
　　　　　.Range("d3").Value = "'" & Mid(hextobin(Mid(csinstr, 3, 1)), 2, 3)
　　　　　For idx = 4 To 8
　　　　　　.Range("d3").Value = .Range("d3").Value & "　" & hextobin(Mid(csinstr, idx, 1))
　　　　　　Next
　　　　　
　　　　　With .Range("e3")
　　　　　　 .Value = "'" & csinstr
　　　　　　 .HorizontalAlignment = xlLeft

　　　　　　 End With
　　　　　.Range("a4:e4").Value = Array("ＢＩＴ構成", "'1", "'8", "'　 23", "'32")
　　　　　.Range("e4").HorizontalAlignment = xlCenter
　　　　　With .Range("a5:e5")
　　　　　　 .MergeCells = True
　　　　　　 .Value = "倍精度浮動小数点型"
　　　　　　 .Font.Size = 14
　　　　　　 .HorizontalAlignment = xlLeft
　　　　　　 .Interior.ColorIndex = 34
　　　　　　 End With
　　　　　.Range("a6:d6").Value = Array("説明", "符号", "指数部", "仮数部", "ヘキサイメージ")
　　　　　.Range("d6").HorizontalAlignment = xlCenter
　　　　　.Range("e6").HorizontalAlignment = xlCenter
　　　　　csinstr = floating_point(cnvnum, 1)
　　　　　.Range("a7").Value = "'値----　" & cnvnum
　　　　　.Range("b7").Value = "'" & Mid(hextobin(Mid(csinstr, 1, 1)), 1, 1)
　　　　　.Range("c7").Value = "'" & Mid(hextobin(Mid(csinstr, 1, 1)), 2, 3) & "　" & hextobin(Mid(csinstr, 2, 1)) & _
　　　　　　　　　　　　　　　　　　　　 "　" & hextobin(Mid(csinstr, 3, 1))
　　　　　.Range("d7").Value = "'" & hextobin(Mid(csinstr, 4, 1))
　　　　　For idx = 5 To 16
　　　　　　.Range("d7").Value = .Range("d7").Value & "　" & hextobin(Mid(csinstr, idx, 1))
　　　　　　Next
　　　　　With .Range("e7")
　　　　　　 .Value = "'" & csinstr
　　　　　　 .HorizontalAlignment = xlLeft
　　　　　　 End With
　　　　　.Range("a8:e8").Value = Array("ＢＩＴ構成", "'1", "'11", "'　 52", "'64")
　　　　　.Range("e8").HorizontalAlignment = xlCenter
　　　　　.Range("a:e").EntireColumn.AutoFit
　　　　　End With
　　　 End If
End Sub
'=====================================================================
Function hextobin(hexstr As String) As String
'指定されたハーフバイト分(一桁）の１６進数を２進数に変換する
'in----hexstr----１６進数（０～Ｆ）
'out---hextobin--変換されたBITイメージ（２進数）ハーフバイト分
　　Dim idx As Long
　　Dim wk As Integer
　　wk = Int("&h" & hexstr)
　　For idx = 3 To 0 Step -1
　　　 If 2 ^ idx And wk Then
　　　　　hextobin = hextobin & "1"
　　　 Else
　　　　　hextobin = hextobin & "0"
　　　　　End If
　　　 Next
End Function
'=====================================================================
Function floating_point(ByVal myvalue As Variant, ByVal typ As Long) As String
'指定された型の数値のメモリーイメージをHEXコードで出力する
'in　----myvalue----数値
'　 typ=0--single　1--double 2----currency
'out-----ｆloating_Point　---メモリーイメージ（HEXコードで）
　　On Error Resume Next
　　Const typ_sin = 0
　　Const typ_dbl = 1
　　Const typ_cur = 2
　　Const flnm = "\binary.tmp"
　　Dim dbb(0 To 7) As Byte
　　Dim sbb(0 To 3) As Byte
　　Dim idx As Long
　　Dim mes As String
　　Dim dd As Double
　　Dim ss As Single
　　Dim cc As Currency
　　Dim fnum As Long
　　Dim wk As String
　　Select Case typ
　　　Case typ_sin
　　　 ss = CSng(myvalue)
　　　Case typ_dbl
　　　 dd = CDbl(myvalue)
　　　Case typ_cur
　　　 cc = CCur(myvalue)
　　　End Select
　　Kill ThisWorkbook.Path & flnm
　　On Error GoTo 0
　　fnum = FreeFile()
　　Open ThisWorkbook.Path & flnm For Random As #fnum Len = IIf(typ = typ_sin, UBound(sbb()) + 1, UBound(dbb()) + 1)
　　Select Case typ
　　　Case typ_sin
　　　　Put #fnum, , ss
　　　　Get #fnum, 1, sbb()
　　　Case typ_dbl
　　　　Put #fnum, , dd
　　　　Get #fnum, 1, dbb()
　　　Case typ_cur
　　　　Put #fnum, , cc
　　　　Get #fnum, 1, dbb()
　　　End Select
　　Close #fnum
　　Kill ThisWorkbook.Path & flnm
　　floating_point = ""
　　For idx = IIf(typ = typ_sin, UBound(sbb()), UBound(dbb())) To 0 Step -1
　　　 If typ = typ_sin Then
　　　　　wk = Hex(sbb(idx))
　　　　　If Len(wk) = 1 Then wk = "0" & wk
　　　　　floating_point = floating_point & wk
　　　 Else
　　　　　wk = Hex(dbb(idx))
　　　　　If Len(wk) = 1 Then wk = "0" & wk
　　　　　floating_point = floating_point & wk
　　　　　End If
　　　 Next
　　Erase sbb(), dbb()
End Function

＊＊マクロは一度、必ず保存してから使用してください

何も書かれていないシートをアクティブにしてmainを実行します。

１．数字の入力要求がありますから、
　　内部形式が知りたい任意の数字を指定してください。
　　入力したら、「ＯＫ」をクリックしてください。

２.アクティブシートに対して以下のレイアウトで
　　単精度及び、倍精度のビットイメージを作成します。

数字として、７を指定した場合。

単精度浮動小数点型　　　　　　　　　　　　　　　　
説明　符号　指数部　　　　　仮数部　　　　　　　　　　　　　　　　　ヘキサイメージ
値-7　0　　100　0000　1　　110　0000　0000　0000　0000　0000　　　40E00000
構成　1　　　8　　　　　　　　　23　　　　　　　　　　　　　　　　　　　　　　　　　32

倍精度浮動小数点型　　　　　　　　　　　　　　　　
・
・（横に長いから省略）
・

符号、指数部、仮数部の詳細は、「浮動小数点」で調べていただくとして

７の場合、

符号-------0----正数

指数部---10000001(二)------＞129
バイアス定数が127なので129-127＝2　　2＾2

仮数部
110・・・・

1/2＋1/4＝0.75------>1が省略されているので仮数部は1.75

よって、1.75＊2＾2＝７

で上記のビットイメージが正しいことがわかります。

実際には、倍精度も同じように出力されます。

色々な数字で試してみてください。

・ツリー全体表示

【150】浮動小数点型の内部形式

ichinose - 06/7/31(月) 13:43 -


	引用なし

	パスワード

任意の数値の単精度浮動小数点型（Single）や倍精度浮動小数点型（Double）の
内部形式のビットイメージを知りたい。

sub Test()
　 dim ss as single
　 dim dd as double
　 ss=7
　 dd=7
'このときのssとddの内部データ形式が知りたいのですが・・・
end sub

　

・ツリー全体表示

【149】Re:文字列左にあるシングルクォーテーショ...

Jaka - 06/7/19(水) 10:58 -


	引用なし

	パスワード

これで良いみたい。

Sub TEST2()
　 Dim WBN As String, Wsh As String
　 WBN = "BOOK2"　　　 'ActiveWorkbook.Name
　 Wsh = "Sheet2"　　　'ActiveSheet.Name
　 With Workbooks(WBN).Sheets(Wsh)
　　　 For i = 1 To .Range("A65536").End(xlUp).Row
　　　　　If .Cells(i, "A").PrefixCharacter = "'" Then
　　　　　　 .Cells(i, "B").Value = "接頭辞有り"
　　　　　Else
　　　　　　 .Cells(i, "B").Value = "接頭辞無し"
　　　　　End If
　　　 Next
　 End With
End Sub

・ツリー全体表示

┃ ┃一覧表示 ┃ ┃ ┃ ┃

7 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free