【VBA】Excel出力
マスタのCD分、Excel出力
'//// Excel出力 Public Sub ExcelOut(ByVal pMysql As String, ByVal pFilePath As String) On Error GoTo ErrHnd Dim qryName As String qryName = "Q_Dummy" 'クエリ名の指定 'エクセル出力用クエリ"qryName"の存在を確認。無い場合は作成 If DCount("*", "[MsysObjects]", "[Name]='" & qryName & "' And [Type]=5") = 0 Then Dim qdf As DAO.QueryDef Set qdf = CurrentDb.CreateQueryDef(qryName, pMysql) 'クエリの作成 qdf.Close: Set qdf = Nothing End If 'クエリ内のSQLの書き換え CurrentDb.QueryDefs(qryName).SQL = pMysql 'エクセルに出力 DoCmd.TransferSpreadsheet acExport, 10, qryName, pFilePath, True, "" MsgBox "出力しました" Exit Sub ErrHnd: Select Case Err.Number Case 2501 'キャンセル処理 MsgBox "キャンセルしました" Case 2302 '書き込みエラー MsgBox "ファイルの書き込みに失敗しました。" Case 3061, 3075, 3078, 3131 'SQL構文エラー MsgBox "SQL構文エラーです" Case Else MsgBox "ErrorCode:" & Err.Number & Chr(13) & _ "ErrorDescription:" & Err.Description End Select End Sub
Private Sub Exp() Dim DB As DAO.Database Dim RS As DAO.Recordset Dim strSQL As String Dim FilePath As String FilePath = CreateObject("WScript.shell").specialfolders("Desktop") & "\" Set DB = CurrentDb strSQL = "SELECT * FROM TM_園マスタ;" Set RS = DB.OpenRecordset(strSQL) 'レコードの存在チェック If RS.BOF = True And RS.EOF = True Then GoTo Finally End If Do Until RS.EOF Dim strSQLw As String Dim FilePathw As String Dim NameCD As Integer NameCD = RS![園CD] strSQLw = "SELECT * FROM T_kojin WHERE [園CD] = " & NameCD & ";" FilePathw = FilePath & NameCD & "_" & RS![園名] & ".xlsx" Call ExcelOut(strSQL, FilePathw) RS.MoveNext Loop Finally: RS.Close DB.Close Set RS = Nothing Set DB = Nothing End Sub
DataGridViewでEnterキーが押された時に横のセルに移動したい
ちょっと苦手なDataGridViewのメモ
CellEnterイベントとかでEnterキーの時はTabキーを送るようにしていたんだけど
ReadOnlyのセルはとばしたかったり、最終行がReadOnlyだったらとか
制御が面倒になってきて、結局DataGridViewを継承したカスタムコントロールを作るのが一番手っ取り早かったので。
あちこち参考にさせていただき、今はこれに落ち着きました。
今回のバグはこれで何とかなりそう～。たぶん
*******
Enterキーでフォーカス横移動
ReadOnly＝Trueのセルは飛ばす
最終列がReadOnlyの場合は次の行へ移動
最終行だった場合は最初の行に戻る
********
'/////////////////// ' DataGridView '/////////////////// ''' <summary> ''' DataGridView ''' Enterキーが押された時に、Tabキーが押されたのと同じ動作をする ''' （現在のセルを隣のセルに移動する） ''' ReadOnlyのセルはとばす ''' </summary> Public Class DataGridViewEx Inherits DataGridView Protected Overrides Function ProcessDialogKey(ByVal keyData As Keys) As Boolean If (keyData And Keys.KeyCode) = Keys.Tab OrElse (keyData And Keys.KeyCode) = Keys.Enter Then '現在のセルの次の列 Dim col As Integer = Me.CurrentCell.ColumnIndex + 1 While col < Me.Columns.Count If Not Me.Rows(Me.CurrentCell.RowIndex).Cells(col).ReadOnly And Me.Rows(Me.CurrentCell.RowIndex).Cells(col).Visible Then Exit While End If col = col + 1 End While If col < Me.Columns.Count Then Me.CurrentCell = Me.Rows(Me.CurrentCell.RowIndex).Cells(col) Else '行 Dim row As Integer = Me.CurrentCell.RowIndex + 1 Dim Flg As Boolean = False '無限ループ防止フラグ If row = Me.Rows.Count Then '最終行の場合は最初の行に戻す row = 0 Flg = True End If While row < Me.Rows.Count For col = 0 To Me.Columns.Count - 1 If Not Me.Rows(row).Cells(col).ReadOnly And Me.Rows(row).Cells(col).Visible Then Exit While End If Next If row = Me.Rows.Count - 1 And Flg = False Then '1回だけ最初の行に戻す row = 0 Flg = True Else row = row + 1 End If End While If col < Me.Columns.Count Then Me.CurrentCell = Me.Rows(row).Cells(col) End If End If Return True End If Return MyBase.ProcessDialogKey(keyData) End Function Protected Overrides Function ProcessDataGridViewKey(ByVal e As KeyEventArgs) As Boolean If e.KeyData = Keys.Tab OrElse e.KeyData = Keys.Enter Then Dim col As Integer = Me.CurrentCell.ColumnIndex + 1 While col < Me.Columns.Count If Not Me.Rows(Me.CurrentCell.RowIndex).Cells(col).ReadOnly And Me.Rows(Me.CurrentCell.RowIndex).Cells(col).Visible Then Exit While End If col = col + 1 End While If col < Me.Columns.Count Then Me.CurrentCell = Me.Rows(Me.CurrentCell.RowIndex).Cells(col) Else '行 Dim row As Integer = Me.CurrentCell.RowIndex + 1 Dim Flg As Boolean = False '無限ループ防止フラグ If row = Me.Rows.Count Then '最終行の場合は最初の行に戻す row = 0 Flg = True End If While row < Me.Rows.Count For col = 0 To Me.Columns.Count - 1 If Not Me.Rows(row).Cells(col).ReadOnly And Me.Rows(row).Cells(col).Visible Then Exit While End If Next If row = Me.Rows.Count - 1 And Flg = False Then '1回だけ最初の行に戻す row = 0 Flg = True Else row = row + 1 End If End While If col < Me.Columns.Count Then Me.CurrentCell = Me.Rows(row).Cells(col) End If End If Return True End If Return MyBase.ProcessDataGridViewKey(e) End Function End Class
＜SQLServer＞テーブルの保存でエラー
自分メモ
テーブルをちょこっと変更して保存しようとしたらエラー。
変更の保存が許可されていません。
時々遭遇してたんだけど、調べるの面倒だし時間ないしとか色々あって
テーブルの再作成してごにょごにょしてました。
ちょっと今日はその気になったので調べました。
すぐ出てきました。
もしかしたらテーブルの再作成するより早かったかもしれない・・・。
「ツール」-「オプション」のデザイナーにある
□テーブルの再作成を必要とする変更を保存できないようにする
のチェック外す。
＜SQLServer＞復元
自分めも。
バックアップに続いて、もれなく復元にもハマるわけです。
私あほすぎる。
ひゃっほーい
「オプション」の復元オプション
「□既存のデータベースを上書きする」
にチェックで解決でした。
＜SQLServer＞バックアップ
自分めも。
めったにしないもんだから、毎回はまります。
何も考えずバックアップすると怒られます。
なんでかなー。
「メディアオプション」で「新しいメディアセットにバックアップし、すべての既存のバックアップセットを消去する」
を選択するとできました。
ここ、参考にさせていただきました。
助かりました。
「ファイルを開く」ダイアログボックスの表示
めも
''' <summary> ''' 「ファイルを開く」ダイアログボックスの表示 ''' </summary> ''' <param name="pFileName">初期表示するファイル名</param> ''' <param name="pDirectory">初期表示するディレクトリ</param> ''' <param name="pFilter">ファイルのフィルタ</param> ''' <param name="pFilterIndex">ファイルの種類 の初期設定</param> ''' <param name="pTitle">タイトル</param> ''' <param name="pMultiselect">複数のファイルを選択可能にする (初期値 False)</param> ''' <returns>ファイルのフルパス</returns> Public Function OpenFileName(Optional ByVal pFileName As String = "", Optional ByVal pDirectory As String = "C:\", Optional ByVal pFilter As String = "CSVファイル(*.csv)|*.csv;|すべてのファイル(*.*)|*.*", Optional ByVal pFilterIndex As Integer = 1, Optional ByVal pTitle As String = "ファイルを選択してください", Optional ByVal pMultiselect As Boolean = False) As String Dim ofd As New OpenFileDialog() ofd.FileName = pFileName ofd.InitialDirectory = pDirectory ofd.Filter = pFilter ofd.FilterIndex = pFilterIndex ofd.Title = pTitle ofd.Multiselect = pMultiselect ' ダイアログボックスを閉じる前に現在のディレクトリを復元する (初期値 False) 'ofd.RestoreDirectory = True ' [ヘルプ] ボタンを表示する (初期値 False) 'ofd.ShowHelp = True ' [読み取り専用] チェックボックスを表示する (初期値 False) 'ofd.ShowReadOnly = True ' [読み取り専用] チェックボックスをオンにする (初期値 False) 'ofd.ReadOnlyChecked = True ' 存在しないファイルを指定した場合は警告を表示する (初期値 True) 'OpenFileDialog1.CheckFileExists = True ' 存在しないパスを指定した場合は警告を表示する (初期値 True) 'OpenFileDialog1.CheckPathExists = True ' 拡張子を指定しない場合は自動的に拡張子を付加する (初期値 True) 'OpenFileDialog1.AddExtension = True ' 有効な Win32 ファイル名だけを受け入れるようにする (初期値 True) 'OpenFileDialog1.ValidateNames = True ' ダイアログを表示し、戻り値が [OK] の場合は、選択したファイルを表示する If ofd.ShowDialog() = DialogResult.OK Then If pMultiselect Then '複数選択の場合 Dim strResult As String = "" For Each nFileName As String In ofd.FileNames strResult = strResult & "," & ofd.FileName Next nFileName OpenFileName = strResult Else OpenFileName = ofd.FileName End If Else 'キャンセルの時 OpenFileName = "" End If ofd.Dispose() End Function
