債務整理太陽光発電
HOME代行・作成実績プロフィール備忘録リンク集更新
 
りゅりゅりゅのエクセルマクロ・パソコン相談所
(備忘録)
 

Sub シート作成_ABC ()
Dim aaa As String
aaa = "AT" Dim i As Integer
For i = 44 To 100
aaa = "AT" & i
aaa = Range(aaa).Text
If aaa = "" Then
MsgBox ("終了 ")
Exit Sub
End If
Sheets("ABC").Select
Sheets("ABC").Copy Before:=Sheets(1)
Sheets("ABC (2)").Select
Sheets("ABC (2)").Name = aaa
Range("G50:R52").Select
ActiveCell.FormulaR1C1 = aaa
Range("G53").Select
Next
End Sub

ファイル名:form1.vb
Imports Oracle.DataAccess.Client
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
'データベースデータの読み込み
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim sConn As String = "User Id= rcs;password=rcs;Data Source=; Dim conn As OracleConnection
conn = New OracleConnection(sConn)
conn.Open()
MessageBox.Show("データベースをオープンしました。")
Dim aaa As String
Dim bbb As String
Dim ccc As String
Dim cmd As OracleCommand
cmd = New OracleCommand("select * from tbl_zaiseki", conn)
Dim Rdr As OracleDataReader
Rdr = cmd.ExecuteReader()
Try
Rdr.Read()
aaa = Rdr("NAME")
bbb = Rdr("BIRTH")
ccc = Rdr("KINMUNO")
MyListBox2.Items.Clear()
MyListBox2.Items.Add(aaa)
MyListBox3.Items.Clear()
MyListBox3.Items.Add(bbb)
MyListBox4.Items.Clear()
MyListBox4.Items.Add(ccc)
Catch
MessageBox.Show("エラーが起こりました")
Rdr.Close()
Rdr.Dispose()
End Try
conn.Close()
MessageBox.Show("データベースをクローズしました。")
End Sub
'CSVファイルの読み込み
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
OpenFileDialog1.Filter = "CSVfile|*.csv" OpenFileDialog1.ShowDialog()
Dim strFileName As String
strFileName = OpenFileDialog1.FileName
GetFileLines(strFileName)
End Sub
'Fileの行数をカウントする
Function GetFileLines(ByVal strFileName As String) As Long
Dim i As Long
i = 0
'ファイルをシステムの現在のエンコードで開く
Dim srFile As New System.IO.StreamReader(strFileName, System.Text.Encoding.Default)
'ファイルの末尾に達するまで1行ずつ読み込む
MyListBox1.Items.Clear()
MyListBox2.Items.Clear()
MyListBox3.Items.Clear()
MyListBox4.Items.Clear()
MyListBox5.Items.Clear()
Do Until srFile.Peek = -1
Dim strLine As String = srFile.ReadLine()
Console.WriteLine(strLine) 'ここがデバッグの時にでてくる
Dim myArray() As String = Split(strLine, ",")
If myArray(1).ToString = "" Then
Exit Do
End If
MyListBox2.Items.Add(myArray(0))
MyListBox3.Items.Add(myArray(1))
MyListBox4.Items.Add(myArray(2))
i = i + 1
Loop
'ファイルを閉じる
srFile.Close()
GetFileLines = i
End Function
Private Class MyListBox
Inherits ListBox
Public Event Scroll()
Protected Overrides Sub WndProc(ByRef m As Message)
Const WM_VSCROLL As Integer = &H115I
If m.Msg = WM_VSCROLL Then
RaiseEvent Scroll()
End If
MyBase.WndProc(m)
End Sub
Protected Overrides Sub OnMouseWheel(ByVal e As MouseEventArgs)
If e.Delta <> 0 Then
RaiseEvent Scroll()
End If
End Sub
Protected Overrides Sub OnSelectedIndexChanged(ByVal e As EventArgs)
RaiseEvent Scroll()
End Sub
End Class
Private WithEvents MyListBox1, MyListBox2, MyListBox3, MyListBox4, MyListBox5 As New MyListBox()
Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
SuspendLayout()
'カスタムListBoxの作成
MyListBox1.Name = "MyListBox1" MyListBox2.Name = "MyListBox2" MyListBox3.Name = "MyListBox3" MyListBox4.Name = "MyListBox4" MyListBox5.Name = "MyListBox5" MyListBox1.Size = New Size(100, 100)
MyListBox2.Size = New Size(100, 100)
MyListBox3.Size = New Size(100, 100)
MyListBox4.Size = New Size(100, 100)
MyListBox5.Size = New Size(100, 100)
MyListBox1.Location = New Point(40, 40)
MyListBox2.Location = New Point(140, 40)
MyListBox3.Location = New Point(240, 40)
MyListBox4.Location = New Point(340, 40)
MyListBox5.Location = New Point(440, 40)
'ダミーデータの作成
Dim R As New Random()
Dim I As Integer
For I = 1 To 100
MyListBox1.Items.Add(New String("*"c, R.Next(1, 20)))
MyListBox2.Items.Add(New String("@"c, R.Next(1, 20)))
MyListBox3.Items.Add(New String("@"c, R.Next(1, 20)))
MyListBox4.Items.Add(New String("@"c, R.Next(1, 20)))
MyListBox5.Items.Add(New String("@"c, R.Next(1, 20)))
Next
Me.Controls.Add(MyListBox1)
Me.Controls.Add(MyListBox2)
Me.Controls.Add(MyListBox3)
Me.Controls.Add(MyListBox4)
Me.Controls.Add(MyListBox5)
ResumeLayout()
End Sub
'スクロールの同期
Private Sub MyListBox1_Scroll() Handles MyListBox1.Scroll
MyListBox2.TopIndex = MyListBox1.TopIndex
MyListBox3.TopIndex = MyListBox1.TopIndex
MyListBox4.TopIndex = MyListBox1.TopIndex
MyListBox5.TopIndex = MyListBox1.TopIndex
End Sub
Private Sub MyListBox2_Scroll() Handles MyListBox2.Scroll
MyListBox1.TopIndex = MyListBox2.TopIndex
MyListBox3.TopIndex = MyListBox2.TopIndex
MyListBox4.TopIndex = MyListBox2.TopIndex
MyListBox5.TopIndex = MyListBox2.TopIndex
End Sub
Private Sub MyListBox3_Scroll() Handles MyListBox3.Scroll
MyListBox2.TopIndex = MyListBox3.TopIndex
MyListBox1.TopIndex = MyListBox3.TopIndex
MyListBox4.TopIndex = MyListBox3.TopIndex
MyListBox5.TopIndex = MyListBox3.TopIndex
End Sub
Private Sub MyListBox4_Scroll() Handles MyListBox4.Scroll
MyListBox1.TopIndex = MyListBox4.TopIndex
MyListBox2.TopIndex = MyListBox4.TopIndex
MyListBox3.TopIndex = MyListBox4.TopIndex
MyListBox5.TopIndex = MyListBox4.TopIndex
End Sub
Private Sub MyListBox5_Scroll() Handles MyListBox5.Scroll
MyListBox4.TopIndex = MyListBox5.TopIndex
MyListBox3.TopIndex = MyListBox5.TopIndex
MyListBox2.TopIndex = MyListBox5.TopIndex
MyListBox1.TopIndex = MyListBox5.TopIndex
End Sub
'選択の同期
Private Sub MyListBox1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyListBox1.Click
Dim i As Integer
i = MyListBox1.SelectedIndex
MyListBox1.SetSelected(i, True)
MyListBox2.SetSelected(i, True)
MyListBox3.SetSelected(i, True)
MyListBox4.SetSelected(i, True)
MyListBox5.SetSelected(i, True)
End Sub
Private Sub MyListBox2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyListBox2.Click
Dim i As Integer
i = MyListBox2.SelectedIndex
MyListBox1.SetSelected(i, True)
MyListBox2.SetSelected(i, True)
MyListBox3.SetSelected(i, True)
MyListBox4.SetSelected(i, True)
MyListBox5.SetSelected(i, True)
End Sub
Private Sub MyListBox3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyListBox3.Click
Dim i As Integer
i = MyListBox3.SelectedIndex
MyListBox1.SetSelected(i, True)
MyListBox2.SetSelected(i, True)
MyListBox3.SetSelected(i, True)
MyListBox4.SetSelected(i, True)
MyListBox5.SetSelected(i, True)
End Sub
Private Sub MyListBox4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyListBox4.Click
Dim i As Integer
i = MyListBox4.SelectedIndex
MyListBox1.SetSelected(i, True)
MyListBox2.SetSelected(i, True)
MyListBox3.SetSelected(i, True)
MyListBox4.SetSelected(i, True)
MyListBox5.SetSelected(i, True)
End Sub
Private Sub MyListBox5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyListBox5.Click
Dim i As Integer
i = MyListBox5.SelectedIndex
MyListBox1.SetSelected(i, True)
MyListBox2.SetSelected(i, True)
MyListBox3.SetSelected(i, True)
MyListBox4.SetSelected(i, True)
MyListBox5.SetSelected(i, True)
End Sub
End Class
// メモ帳04の続き1
b_stop = new Button("中 断"); // Suspendボタンを生成
b_reset = new Button("やり直し"); // Resetボタンを生成
add(b_start);
add(b_stop);
add(b_reset); // ボタンを取り付け
add(new Label(" alpha=")); // ラベルを取り付け
ch_alph = Choice();// チョイスを生成
ch_alph.addItem("0.0004");
// チョイスの項目設定
ch_alph.addItem("0.0006"); ch_alph.addItem("0.0008");
ch_alph.select(1);
// alphaの初期値を2番目に設定
add(ch_alph); // alphaのチョイスを取り付け
bt_start.addActionListener(this);// インターフェイスに関連付け
bt_stop.addActionListener(this);
bt_reset.addActionListener(this);
ch_alph.addItemListener(this);
setBackground(Color.lightGray); // 背景色設定
// ウィンドウ座標表示系の初期化
drw = new DrawCanvas(img,bg,wx,wy);
// 初期条件の代入とその表示
sol.inputData();
drw.viewPort(20,0,false,sol.getRange());// ビューポート変換
Public Class
AuthorAttribute
Inherits Attribute
Private _name As String
Public Sub New(ByVal name as String)
_name = name
End Sub
Public ReadOnly Property name() as String
Get
Return _name
End Get
End Property
End Class
Public Class Test1
End Class
Public Class Test2
End Class
Public Class Form1
End Class
Inherits System.Windows.Forms.Form
Public Sub dumpAuthor(ByVal classname as String)
Dim targetType as Type = Type.GetType("Sample007n." + className)
Dim list() as Object= _
targetType.GetCustomAttributes(GetType(AuthorAttribute),False)
dim item as AuthorAttribute
For Each item In list
Trace.WriteLine("class " & className & "is written by " & item.name)
Next
End Sub
Private Sub Form1_Load(ByVal sender as System.Object,ByVal e as
System.EventArgs)Handles MyBase.Load
dumpAuthor("Test1")
dumpAuthor("Test2")
dumpAuthor("Form1")
End Sub
End Class
Public Class
AuthorAttribute
Inherits Attribute Private _name As String
Public Sub New(ByVal name as String)
_name = name
End Sub
Public ReadOnly Property name() as String
Get
Return _name
End Get
End Property
End Class
Public Sub Test1()
End Sub
Public Sub Test2()
End Sub
Public Sub DumpAuthor(ByVal methodName as String)
Dim info as System.Reflection.MethodInfo = me.GetType().GetMethod(methodName)
Dim list() as Object= info.GetCustomAttributes(GetType(AuthorAttribute),False)
dim item as AuthorAttribute
For Each item In list
Trace.WriteLine("method " & methodName & "is written by " & item.name)
Next
End Sub
Private Sub Form1_Load(ByVal sender as System.Object,ByVal e as
System.EventArgs)Handles MyBase.Load
DumpAuthor("Test1")
DumpAuthor("Test2")
DumpAuthor("DumpAuthor")
End Sub
E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ
E7 2 月 16日 17日 18日 19日 20日 21日 22日 23日 24日 25日 26日 27日 28日 29日 30日 31日 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
E8 区分\曜日 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木
E9 勤務区分 日勤 日勤 日勤 日勤 日勤 日勤 日勤 夜勤 夜勤 夜勤 夜勤 夜勤 夜勤 夜勤 日勤 日勤 日勤 日勤 日勤 日勤 日勤 夜勤 夜勤 夜勤 夜勤 夜勤 夜勤 夜勤 日勤 日勤 日勤
E10 実働時間 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75 7.75
E11 残業時間
E12 深夜時間
E13 休出時間
E14 法定休出
E15 食事
-------------------------------------------------------------------------------- From: "? ["
To: sasasasasa854@hotmail.com
Subject: マクロ(勤怠入力)
Date: Fri, 16 Mar 2007 20:50:28 +0900
’勤怠入力(ABC)
Private Sub CommandButton1_Click()
Dim strchar_conv As Variant
Dim strint_conv As Integer
Dim cell_conv As Variant
Dim cell_conv_next As Variant
Dim cnt_shifu As Integer
Range(Selection.Address(0, 0)).Select
str_cell = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
strchar_conv = Mid(str_cell, 1, 1)
strint_conv = Mid(str_cell, 2, 2)
cnt_shifu = 1
'------------------------------------入力の開始 ----------------------------------------------

For aaa = Asc(strchar_conv) To Asc("Z") 'AからZになるまで繰り返す

If UserForm1.ComboBox1.ListIndex = 0 Then '日勤を選択
Select Case cnt_shifu
Case 1, 2, 3, 4, 5, 6, 7 _
, 15, 16, 17, 18, 19, 20, 21 _
, 29, 30, 31
cell_conv = Chr(aaa) & strint_conv
cell_conv_next = Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = UserForm1.ComboBox1.Value
Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1

Case 8, 9, 10, 11, 12, 13, 14 _
, 22, 23, 24, 25, 26, 27, 28 '8日後からシフトの変更

cell_conv = Chr(aaa) & strint_conv
cell_conv_next = Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = "夜勤 " Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
End Select
Else
Select Case cnt_shifu
Case 1, 2, 3, 4, 5, 6, 7 _
, 15, 16, 17, 18, 19, 20, 21 _
, 29, 30, 31
cell_conv = Chr(aaa) & strint_conv
cell_conv_next = Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = UserForm1.ComboBox1.Value
Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
Case 8, 9, 10, 11, 12, 13, 14 _
, 22, 23, 24, 25, 26, 27, 28
cell_conv = Chr(aaa) & strint_conv
cell_conv_next = Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = "日勤 " Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
End Select
End If
Next
For aaa = Asc("A") To Asc("J")
If UserForm1.ComboBox1.ListIndex = 0 Then
Select Case cnt_shifu
Case 1, 2, 3, 4, 5, 6, 7 _
, 15, 16, 17, 18, 19, 20, 21 _
, 29, 30, 31

cell_conv = "A" & Chr(aaa) & strint_conv
cell_conv_next = "A" & Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = UserForm1.ComboBox1.Value
Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1

Case 8, 9, 10, 11, 12, 13, 14 _
, 22, 23, 24, 25, 26, 27, 28

cell_conv = "A" & Chr(aaa) & strint_conv
cell_conv_next = "A" & Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = "夜勤 " Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
End Select

Else

Select Case cnt_shifu
Case 1, 2, 3, 4, 5, 6, 7 _
, 15, 16, 17, 18, 19, 20, 21 _
, 29, 30, 31
cell_conv = "A" & Chr(aaa) & strint_conv
cell_conv_next = "A" & Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = UserForm1.ComboBox1.Value
Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
Case 8, 9, 10, 11, 12, 13, 14 _
, 22, 23, 24, 25, 26, 27, 28
cell_conv = "A" & Chr(aaa) & strint_conv
cell_conv_next = "A" & Chr(aaa) & strint_conv + 1
Range(cell_conv).Value = "日勤 " Range(cell_conv_next).Value = UserForm1.ComboBox2.Value
cnt_shifu = cnt_shifu + 1
End Select
End If
Next
'-------------------------------------入力の終了 --------------------------------------------
'日勤
Dim RE, strPattern As String, r As Range
Set RE = CreateObject("VBScript.RegExp")
strPattern = "日勤 " ' strPattern = "^田(中|口).*(子|美)$"
With RE
.Pattern = strPattern ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True ''文字列全体を検索
For Each r In ActiveSheet.UsedRange
If .test(r.Formula) Then r.Interior.ColorIndex = 36
Next r
End With


strPattern = "夜勤 " With RE
.Pattern = strPattern ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True ''文字列全体を検索
For Each r In ActiveSheet.UsedRange
If .test(r.Formula) Then r.Interior.ColorIndex = 34

Next r
End With

strPattern = "欠勤 " With RE
.Pattern = strPattern ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True ''文字列全体を検索
For Each r In ActiveSheet.UsedRange
If .test(r.Formula) Then r.Font.ColorIndex = 3
Next r
End With
strPattern = "有給" With RE
.Pattern = strPattern ''検索パターンを設定
.IgnoreCase = True ''大文字と小文字を区別しない
.Global = True ''文字列全体を検索
For Each r In ActiveSheet.UsedRange
If .test(r.Formula) Then r.Font.ColorIndex = 3
Next r
End With
Set RE = Nothing
End Sub
Private Sub CommandButton2_Click()
UserForm1.Hide
End Sub
Private Sub UserForm_Initialize()
UserForm1.ComboBox1.Clear
UserForm1.ComboBox1.AddItem ("日勤")
UserForm1.ComboBox1.AddItem ("夜勤")
UserForm1.ComboBox2.Clear
UserForm1.ComboBox2.AddItem ("7.75")
UserForm1.ComboBox2.AddItem ("7.83")
End Sub



Sub Macro1()
' ' Macro1 Macro
' マクロ記録日 : 2007/3/2 ユーザー名
'
'
Range("E8").Select
End Sub

Sub AddressSamp1()

MsgBox (Range(Selection.Address(0, 0)).Address)
MsgBox (Range(Selection.Address(1, 0)).Address)
MsgBox (Range(Selection.Address(0, 1)).Address)


Cells(2, 1).Value = "@" Cells(2, 2).Value = ActiveCell.Address
Cells(3, 1).Value = "A " Cells(3, 2).Value = ActiveCell.Address(RowAbsolute:=False)
Cells(4, 1).Value = "B" Cells(4, 2).Value = ActiveCell.Address(ColumnAbsolute:=False)
Cells(5, 1).Value = "C" Cells(5, 2).Value = ActiveCell.Address(RowAbsolute:=False, _
ColumnAbsolute:=False) Cells(6, 1).Value = "D " Cells(6, 2).Value = ActiveCell.Address(ReferenceStyle:=xlR1C1)
Cells(7, 1).Value = "E" Cells(7, 2).Value = ActiveCell.Address(External:=True)
Cells(8, 1).Value = "F" Cells(8, 2).Value = ActiveCell.Address(ColumnAbsolute:=False, _
RowAbsolute:=False, ReferenceStyle:=xlR1C1, Relativeto:=Cells(8, 2))

Dim aaa As Variant
aaa = Range(Selection.Address(0, 0)).Address
'MsgBox (aaa)
Range(aaa).Value = "aaaaaaaa" End Sub



Const STR_APPNAME As String = "Devices" '目的のキーが所属しているセクションの名前(lpAppName)
Const STR_DEFAULT As String = "見つかりませんでした" '規定の文字列(lpDefault)
Const LNG_SIZE As Long = 1024 '情報を格納するバッファのサイズ(nSize)
Const STR_KEYNAME As String = vbNullString 'セクション内の全てのキーを取得(NULLを指定)




'**標準モジュール*******************************************:
'━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
'【関数名】 GetProfileString
'【機能】  WIN.INIから指定されたエントリの文字列を取得する
'【引数】 '      lpAppName:   String−エントリを検索するセクション
'      lpKeyName:   String−検索するキー名またはエントリ
'      lpDefault:   String−指定されたエントリが見つからなかった時に返される規定値
'      lpReturnedString:'              String−nSizeバイトを割り当てる文字列バッファ
'      nSize:     Long−lpReturnedStringに格納できる最大文字数
'【戻り値】 lpReturnedStringバッファにコピーされたバイト数(最後のNull文字は含まれない)
'━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

'■ GetProfileString API関数(WIN.INIから指定されたエントリの文字列を取得する)
Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long) As Long

'==================================================================================================
'プリンタ名一覧を取得する関数'戻り値:登録されているプリンタの数
'arg_vntPrinter():プリンタ名一覧(配列)
'arg_vntPort():ポート名一覧(配列)
'arg_strErr:エラーメッセージ
Public Function pb_fncGetPrinter(ByRef arg_vntPrinter() As Variant, _
ByRef arg_vntPort() As Variant, ByRef arg_strErr As String) As Long



Dim lngRet As Long 'GetProfileString関数の戻り値
Dim strReturnedString As String * 1024
Dim strTmp As String
Dim lngNull As Long
Dim i As Long
Dim lngStart As Long
Dim strErr As String
On Error GoTo ErrHandler
'-Start---------------------------------------------------------
'プリンタ一覧を取得
'指定したセクション名を検索、セクションの全キーを取得、該当データのバイト数を返す
'バッファ(strReturnedString)に格納された文字数が返る
lngRet = GetProfileString(STR_APPNAME, STR_KEYNAME, STR_DEFAULT, strReturnedString, LNG_SIZE)
'最後のNULLを除く
strTmp = Left(strReturnedString, InStr(1, strReturnedString, Chr(0) & Chr(0)) - 1)
'戻り値チェック
If strTmp = STR_DEFAULT Then
strErr = "プリンター名が取得できませんでした"
GoTo ErrHandler
End If

lngNull = 0
i = 0
lngStart = 0

Do

i = i + 1
lngNull = InStr(lngNull + 1, strTmp, Chr(0))
If lngNull = 0 Then lngNull = Len(strTmp)
ReDim Preserve arg_vntPrinter(1 To i)
arg_vntPrinter(i) = Mid(strTmp, lngStart + 1, lngNull - lngStart)
If Right(arg_vntPrinter(i), 1) = Chr(0) Then
'末尾のNULLを削除
arg_vntPrinter(i) = Left(arg_vntPrinter(i), Len(arg_vntPrinter(i)) - 1)
End If
lngStart = lngNull
Loop Until lngNull = Len(strTmp)

'-End-----------------------------------------------------------
pb_fncGetPrinter = i
ReDim arg_vntPort(1 To i)
'-Start---------------------------------------------------------
'ポート一覧を取得
For i = 1 To pb_fncGetPrinter
lngRet = GetProfileString(STR_APPNAME, arg_vntPrinter(i), STR_DEFAULT, strReturnedString, LNG_SIZE)
'最後のNULLを除く
strTmp = Left(strReturnedString, InStr(1, strReturnedString, Chr(0)) - 1)
strTmp = Mid(strTmp, InStr(1, strTmp, ",") + 1)
'戻り値チェック
If strTmp = STR_DEFAULT Then
strErr = "ポート名が取得できませんでした" GoTo ErrHandler
Else
arg_vntPort(i) = strTmp
End If
Next i
'-End-----------------------------------------------------------
Exit Function

ErrHandler:
arg_strErr = strErr & vbCrLf & _
"フォームを閉じて終了させてください。" & _
vbCrLf & vbCrLf & Err.Number & " : " & Err.Description
pb_fncGetPrinter = 0

End Function
'**フォーム*******************************************:
Private pr_strPrinterArray() As String 'プリンター&ポートのフルネーム
'==================================================================================================
Private Sub CommandButton1_Click()
With ListBox1
If .ListIndex = -1 Then
MsgBox "なにも選択されていません" Else:
MsgBox "選択されているプリンターは" & pr_strPrinterArray(.ListIndex + 1) & " です" End If
End With
End Sub '==================================================================================================

Private Sub UserForm_Initialize()
Dim strErrMsg As String
Dim vntPrinter() As Variant 'プリンター名(配列)
Dim vntPort() As Variant 'ポート名(配列)
Dim lngPrinterCount As Long 'pb_fncGetPrinerの戻り値(登録されているプリンター数)
Dim strActivePrinter As String
Dim i As Long
On Error GoTo ErrHandler
'-Start---------------------------------------------------------
'プリンター名、ポート名の設定
lngPrinterCount = pb_fncGetPrinter(vntPrinter(), vntPort(), strErrMsg)
If lngPrinterCount = 0 Then Resume ErrHandler

ReDim pr_strPrinterArray(1 To lngPrinterCount)

strActivePrinter = Application.ActivePrinter
If strActivePrinter Like "* on *" = True Then
strActivePrinter = Trim(Left(strActivePrinter, InStr(strActivePrinter, " on ") - 1))
For i = 1 To lngPrinterCount pr_strPrinterArray(i) = vntPrinter(i) & " on " & vntPort(i)
Next
ElseIf strActivePrinter Like "* の *" = True Then
strActivePrinter = Trim(Mid(strActivePrinter, InStr(strActivePrinter, " の ") + 3))
For i = 1 To lngPrinterCount
pr_strPrinterArray(i) = vntPort(i) & " の " & vntPrinter(i)
Next End If
With ListBox1
For i = 1 To lngPrinterCount
.AddItem vntPrinter(i)
Next i
End With
'-End----------------------------------------------------------

Exit Sub
ErrHandler:
If Len(strErrMsg) = 0 Then
strErrMsg = "フォームの表示段階でエラーが発生しました" & vbCrLf & _
"フォームを閉じて終了させてください。" & vbCrLf & vbCrLf & _
Err.Number & " : " & Err.Description
End If
MsgBox strErrMsg, vbCritical

End Sub
Sub test()




If MsgBox("印刷しますか?", vbYesNo) = vbYes Then
Application.Dialogs(xlDialogPrinterSetup).Show
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
End Sub


Option Explicit Option Base 0

Dim value() As Integer

Sub bubble_sort()
'バブルソート
'本体(大きいものを後ろに)
Dim max As Integer
Dim t As Integer
Dim i As Variant

ReDim value(9)
value(0) = 1
value(1) = 8
value(2) = 3
value(3) = 2
value(4) = 9
value(5) = 4
value(6) = 10
value(7) = 6
value(8) = 5
value(9) = 7

For max = (10 - 1) - 1 To 0 Step -1
For t = 0 To max
If value(t) > value(t + 1) Then
Call swap(t, t + 1)
End If
Next
Next
' For Each i In value()
' Debug.Print (value(i))
' Next

For i = 0 To 9
Debug.Print (value(i))
Next

End Sub
Sub swap(place1 As Integer, place2 As Integer)
Dim temp As Integer
temp = value(place1)
value(place1) = value(place2)
value(place2) = temp
End Sub
# $OpenBSD: ssh_config,v 1.21 2005/12/06 22:38:27 reyk Exp $ # This is the ssh client system-wide configuration file. See # ssh_config(5) for more information. This file provides defaults for # users, and the values can be changed in per-user configuration files # or on the command line. # Configuration data is parsed as follows: # 1. command line options # 2. user-specific file # 3. system-wide file # Any configuration value is only changed the first time it is set. # Thus, host-specific definitions should be at the beginning of the # configuration file, and defaults at the end. # Site-wide defaults for some commonly used options. For a comprehensive # list of available options, their meanings and defaults, please see the # ssh_config(5) man page. # Host * # ForwardAgent no # ForwardX11 no # RhostsRSAAuthentication no # RSAAuthentication yes # PasswordAuthentication yes # HostbasedAuthentication no # BatchMode no # CheckHostIP yes # AddressFamily any # ConnectTimeout 0 # StrictHostKeyChecking ask # IdentityFile ~/.ssh/identity # IdentityFile ~/.ssh/id_rsa # IdentityFile ~/.ssh/id_dsa # Port 22 # Protocol 2,1 # Cipher 3des # Ciphers aes128-cbc,3des-cbc,blowfish-cbc,cast128-cbc,arcfour,aes192-cbc,aes256-cbc # EscapeChar ~ # Tunnel no # TunnelDevice any:any # PermitLocalCommand no Host * GSSAPIAuthentication yes # If this option is set to yes then remote X11 clients will have full access # to the original X11 display. As virtually no X11 client supports the untrusted # mode correctly we set this to yes. ForwardX11Trusted yes # Send locale-related environment variables SendEnv LANG LC_CTYPE LC_NUMERIC LC_TIME LC_COLLATE LC_MONETARY LC_MESSAGES SendEnv LC_PAPER LC_NAME LC_ADDRESS LC_TELEPHONE LC_MEASUREMENT SendEnv LC_IDENTIFICATION LC_ALL

************************************************************************************************

1.オラクルに接続

2.テーブルの作成
create table blob_test(blob_id number(4,0) primary key,blob_fld blob);

3.テストコードのコンパイル

Imports Oracle.DataAccess.Client
Imports Oracle.DataAccess.Types
Public Class Form1
'バイナリデータ入力(テスト用)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim fs As New System.IO.FileStream("c:\temp\odp.bmp", _
IO.FileMode.Open, IO.FileAccess.Read)
Dim blobData(fs.Length) As Byte
fs.Read(blobData, 0, fs.Length)
Dim cnn As New OracleConnection( _
"user id=rcs;password=rcs;data source=")
Dim strSql As String = _
"insert into blob_test(blob_id, blob_fld) " & _
"values(1, :blobdata)" Dim cmd As New OracleCommand(strSql, cnn)
cnn.Open()
Dim pBlob As OracleParameter = _
cmd.Parameters.Add("blobdata", OracleDbType.Blob)
pBlob.Value = blobData
cmd.ExecuteNonQuery()
End Sub
'バイナリデータ出力(テスト用)
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim cnn As New OracleConnection( _
"user id=rcs;password=rcs;data source=")
Dim strSql As String = _
"select blob_fld from blob_test where blob_id=1"
Dim cmd As New OracleCommand(strSql, cnn)
cnn.Open()
Dim dr As OracleDataReader = cmd.ExecuteReader
If dr.Read Then
Dim blob As OracleBlob = dr.GetOracleBlob(0)
Dim ms As New System.IO.MemoryStream(blob.Value)
PictureBox1.Image = New Bitmap(ms)
End If
End Sub
End Class

インサート分参考
CREATE TABLE TBL_ZAISEKI(
ID NUMBER ( 6)
,NAME CHAR (10) not null
,BIRTH DATE not null
,KINMUNO NUMBER ( 6)
,MEMO CHAR (100)
,PRIMARY KEY(NAME)
);
insert into TBL_ZAISEKI(NAME,BIRTH,KINMUNO) values ('内田',TO_TIMESTAMP('19991118', 'YYYY/MM/DD/HH24:MI:SS'),4);
DELETE FROM TBL_ZAISEKI WHERE NAME = '内田';
'氏名' '生年月日' '' '事業所' '入職日' '退職日' '在職確認' '2007/8/2' '181'
'ああ ああ' '昭和38年11月14日' '' 'ABC工業' '平成16年2月13日' '' 'あり' '' ''

Home

Powered by FC2.com
inserted by FC2 system