Accessのフォーム内にある”合計”欄が、100を超えたら
警告メッセージを出したいのですが、うまく動きません。
どうしたらいいでしょうか？
”合計”欄は、非連結のテキストボックスに、A+B+Cの合計値が入るようになっています。
表示は”％”表示です。
どなたかご教授お願いできますでしょうか。
-------------------------------------------
Private Sub 率合計_AfterUpdate()
If Me!率合計 > 100 Then
MsgBox "100を超えました"
End If
End Sub
csvファイル(test.csv)からフラグが１のものを抽出するのですが
最終行に改行がはってしまうので、最終行を削除してcsvファイルを保存したいのですが、
うまくいきません。ご教授ください。
Dim objADO
Dim i
Dim wsql
Dim rs
Dim wHeader
Dim wData
Dim objFSO
Dim objFile
Set objADO = CreateObject('ADODb.connection')
objADO.Open "Driver={Microsoft Text Driver (*.txt;*csv)};"&_
"DBQ=C:\test;"&_
"ReadOnly=1"
'抽出条件
wsql="select * from test.csv where フラグ='1'"
Set rs =objADO.Execute(Wsql)
'ヘッダ部
wHeader='ID,商品名,商品番号,フラグ"
'データ部
wData=""
Do While rs.EOF=False
For i = 0 to rs.fields.count - 1
if i = (rs.fields.count -1) then
wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & chr(13)
else
wData = wData & chr(34) & rs.Fields.ltem(i) & chr(34) & ","
end if
next
rs.MoveNext
loop
'最終改行削除？
rs = Left(wData,Len(wData) - Len(chr(13)))
'ファイル出力
set objFSO = createObject("Scripting.FileSystemObject")
set objFile = objFSO.OpentextFile("c:\test\test.csv",2, true)
if err.Number = 0 then
objFile.WriteLine(wHeader)
objFile.WriteLine(wData)
objFile.close
end if
set objFile = Nothing
set objFSO = Nothing
set objADO = Nothing
******************************************
ID,商品名,商品番号,フラグ
100,パソコン,100-12,1
200,ペン,200-11,1
***ここの改行を削除する*****
〔EOF〕
ExcelVBAマクロについて確認させてください。
下記のように読み込みたいWordファイルをフォームで指定して
Wordファイルの内容を変数aに読み込ませてます。
変数Xにある任意の文字列を代入し、変数aでその変数Xが検索された場合は
その検索された文字列全てを赤文字にして別の名前で保存という方法は可能でしょうか。
可能であればその方法をご教授下さい。
以上、よろしくお願いいたします。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub sample()
Dim buf As String
Dim a As String
buf = Application.GetOpenFilename(FileFilter:="テキスト文書,*.txt", Title:="サンプル") 'フルパスも含めたファイル名をbufに代入
With CreateObject("Scripting.FileSystemObject").GetFile(buf).OpenAsTextStream '指定したファイルを開く
a = .ReadAll 'テキスト文書の内容を文字列aに代入
.Close '指定したファイルを閉じる
End With
End Sub
ExcelVBAマクロについて確認させてください。
下記のように読み込みたいWordファイルをフォームで指定して
Wordファイルの内容を変数aに読み込ませてます。
変数Xにある任意の文字列を代入し、変数aでその変数Xが検索された場合は
その検索された文字列全てを赤文字にして別の名前で保存という方法は可能でしょうか。
可能であればその方法をご教授下さい。
以上、よろしくお願いいたします。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub sample()
Dim buf As String
Dim a As String
buf = Application.GetOpenFilename(FileFilter:="テキスト文書,*.txt", Title:="サンプル") 'フルパスも含めたファイル名をbufに代入
With CreateObject("Scripting.FileSystemObject").GetFile(buf).OpenAsTextStream '指定したファイルを開く
a = .ReadAll 'テキスト文書の内容を文字列aに代入
.Close '指定したファイルを閉じる
End With
End Sub
↓例で、REC変数を同じプロジェクト内の他basファイルで、使用するとコンパイルエラーになります。
原因が解りません。
対策を教えていただけませんか?
Public REC As String
Private Function test() As String
・
・
・
・
REC = test()
End Function
★から★までのコードがどうしても成立しません、★以外は線分としてコードが成立するのですが
★から★を入れると成立しません。どう構築したいいのでしょうか、宜しくお願いします。
エクセルでCVSファイルの数値を線分として図面に記入するためのコードになります。
説明不足ですが、宜しくお願いします。
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
' LineData用の変数です。
Dim cadLineData As New zwDrawCAD.LineData
Dim cadStartPoint As zwDrawCAD.DPoint = cadLineData.Start
Dim cadEndPoint As zwDrawCAD.DPoint = cadLineData.End
'とりあえず線のスタート点は（100,100）にしてます。
Const X As Integer = 100 'cadStartPoint.x = 100
Const Y As Integer = 100 'cadStartPoint.y = 100
Const xx As Integer = 5
Const yy As Integer = 6
Dim len As Integer 'TextBox1に入力された線の長さ
Dim angle As Double 'TextBox2に入力された角度 単位は度
Dim ansx As Integer '計算された、xの座標
Dim ansy As Integer '計算された、yの座標
★ Dim ddd(5, 6) As Integer 'TEXTの階数
xx = 5
yy = 6
FILETIME = "c:\DummyData.csv"
Open Filename For Input As #1
For i = 1 To yy
For j = 1 To xx
Input #1, ddd(xx, yy)
Next j
Next i
★ Close #1
len = CDbl(TextBox5.Text / 2)
angle = CDbl(TextBox2.Text + 90)
ansx = X + len * (Math.Cos(angle / 180 * Math.PI)) '終点のx座標
ansy = Y + len * (Math.Sin(angle / 180 * Math.PI)) '終点のy座標
cadStartPoint.x = 100
cadStartPoint.y = 100
cadEndPoint.x = ansx
cadEndPoint.y = ansy
' 参照したオブ ジェクトを解放します。
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadStartPoint)
' アクティブなDocumentを参照します。
Dim cadDocument As zwDrawCAD.Document = cadApplication.ActiveDocument
' 現在の作図属性を参照します。
Dim cadCurrentDraw As zwDrawCAD.DrawData = cadDocument.CurrentDraw
' 現在のレイヤ、線種、線幅、線色を設定します。
cadLineData.LayerNo = cadCurrentDraw.LayerNo
cadLineData.PenStyle = cadCurrentDraw.PenStyle
cadLineData.PenWidth = cadCurrentDraw.PenWidth
cadLineData.PenColor = cadCurrentDraw.PenColor
' 参照したオブジェクトを解放します。
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadCurrentDraw)
' データベースを参照します。
Dim cadDataBase As zwDrawCAD.CADDB = cadDocument.DataBase
' Undo情報を設定します。
cadDataBase.SetDelimitter("始点座標(100,100) 終点座標((ansx,ansy) の線分")
' 追加した要素の参照用変数です。
Dim cadAddPrimitive As zwDrawCAD.Primitive
' 要素を追加します。
cadAddPrimitive = cadDataBase.Add(cadLineData)
' 参照したオブジェクトを解放します。
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadAddPrimitive)
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadLineData)
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadDataBase)
System.Runtime.InteropServices.Marshal.ReleaseComObject(cadDocument)
お世話になっております。
エクセルのVBAマクロについて教えてください。
以下のように2種類A,Bの縦に並んだ時系列データがあった場合、
A No1 2012/6/1 1
A No2 2012/7/1 3
A No3 2012/8/1 4
B No1 2012/6/15 2
B No2 2012/7/15 6
B No3 2012/8/15 7
B No4 2012/9/15 9
上記のデータを別のシートに以下のように表示させたいのです。
（上記1列目は以下1列目に対応、上記4列目の数字をA、B単位で累計和を以下2列目に表示）
A 1
A 4
A 8
B 2
B 8
B 15
B 24
以上のVBAマクロの数式の立て方を教えていただけますでしょうか。
よろしくお願いいたします。
ACCESSのVBAを使って、データの集計・分析などをしてEXCELに出力、さらにそのEXCELを少しいじる、←このVBAをVBSで実行 といった事をしていたのですが、
会社の端末が一部Office2003から2010に変わったため、参照設定に不具合が出てきました。
内容は、元々2003で作成されたデータベースを2010で開くとVBAの参照設定が「Microsoft Access 11.0 Object Library」だったものは「Microsoft Access 14.0 Object Library」に変わるのですが、
「Microsoft Excel 11.0 Object Library」は変更されずに参照不可になってしまいます。
以前、別のところで同様の質問をした際に、
→「参照設定」をして、コードを作成したあと、コードに使われている定数を全部調べ上げて、変数宣言のコードを作成し、
参照設定のチェックを外して、宣言のコードを追加する、ということで、参照設定の対策をします。
といった回答を頂いたのですが、いまいち理解できていません。
以下のコードをEXCELの参照設定を外しても動くようにするにはどのようにしたら良いのでしょうか？よろしくお願いします。
Sub TEST()
Dim xls As Excel.Application
Dim wb As Excel.Workbook
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "TEST", "C:\TEST.xls", True
Set xls = CreateObject("Excel.Application")
Set wb = xls.Workbooks.Open("C:\TEST.xls")
With xls
.Sheets("Sheet1").Select
.Range("A1").Value = "成功"
.Visible = True
End With
End Sub
VB.NETというサイトの「フォルダ以下のファイルを最下層まで検索または取得する」(http://jeanne.wankuma.com/tips/vb.net/directory/getfilesmostdeep.html)に書かれているコードを実行しようとしてもエラーが出てしまいます。どのように修正したら実行されるのか、ご教授いただけないでしょうか。よろしくお願いいたします。
ＶＢＡのバージョンは7.0です。
サンプルにある通り、C直下にHogeフォルダを作り、その中にHoge.txtを作ってあります。
標準モジュールに「使用例は以下のようになります。」に書かれているコードを、クラスモジュールには「以下にサンプルコードを示します。」に書かれているコードを張り付けました。クラス名は「GetFilesMostDeep」としています。
下記がコードの内容となっています。
★標準モジュール－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub Macro4()
' ファイル名に「Hoge」を含み、拡張子が「.txt」のファイルを最下層まで検索し取得する
Dim stFilePathes As String() = GetFilesMostDeep("C:\Hoge\", "*Hoge*.txt")
Dim stPrompt As String = String.Empty
' 取得したファイル名を列挙する
For Each stFilePath As String In stFilePathes
stPrompt &= stFilePath & System.Environment.NewLine
Next stFilePath
' 取得したすべてのファイルパスを表示する
If stPrompt <> String.Empty Then
MessageBox.Show (stPrompt)
End If
End Sub
★－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
★クラスモジュール－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
''' ---------------------------------------------------------------------------------------
''' <summary>
''' 指定した検索パターンに一致するファイルを最下層まで検索しすべて返します。</summary>
''' <param name="stRootPath">
''' 検索を開始する最上層のディレクトリへのパス。</param>
''' <param name="stPattern">
''' パス内のファイル名と対応させる検索文字列。</param>
''' <returns>
''' 検索パターンに一致したすべてのファイルパス。</returns>
''' ---------------------------------------------------------------------------------------
Public Shared Function GetFilesMostDeep(ByVal stRootPath As String, ByVal stPattern As String) As String()
Dim hStringCollection As New System.Collections.Specialized.StringCollection()
' このディレクトリ内のすべてのファイルを検索する
For Each stFilePath As String In System.IO.Directory.GetFiles(stRootPath, stPattern)
hStringCollection.Add (stFilePath)
Next stFilePath
' このディレクトリ内のすべてのサブディレクトリを検索する (再帰)
For Each stDirPath As String In System.IO.Directory.GetDirectories(stRootPath)
Dim stFilePathes As String() = GetFilesMostDeep(stDirPath, stPattern)
' 条件に合致したファイルがあった場合は、ArrayList に加える
If Not stFilePathes Is Nothing Then
hStringCollection.AddRange (stFilePathes)
End If
Next stDirPath
' StringCollection を 1 次元の String 配列にして返す
Dim stReturns As String() = New String(hStringCollection.Count - 1) {}
hStringCollection.CopyTo(stReturns, 0)
Return stReturns
End Function
ご多忙中申し訳ありません。
TextBoxが複数ありまして、↓キーを使用してフォーカスの移動をタブインデックスに従って変更したいのですが、Enterキーなら順番に移動しますが、Downキーですと何も変化がありません。
Downキーの場合は何か、コードの追加が必要でしょうか？
あと、できれば←や↑ →なども使用してフォーカスの移動をしたいとおもいますが
アドバイスをお願いします。
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.KeyPreview = True
End Sub
Private Sub Form1_KeyPress(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles MyBase.KeyPress
If e.KeyChar = Chr(Keys.Down) Then '←ここの部分がEnterキーならフォーカスの移動ができます。
Me.SelectNextControl(Me.ActiveControl, True, True, True, True)
e.Handled = True
End If
End Sub
申し訳ありません。宜しくお願いします。
