Excel VBA質問箱 IV

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

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


41309 / 76732 ←次へ | 前へ→

【40504】シートモジュールのクラス化
質問  ハナ  - 06/7/15(土) 9:11 -

引用なし
パスワード
   いつも参考にさせていただいてます。
XLSで注文書を作成するプログラムを作っているのですが
複数のシート(SH3,SH4,SH5)で全く同じシートモジュールを記述していて
とても効率が悪い感じがするんです。(下記のコードです)
 動作としては
   ・シートがACTIVEになったら
      シート保護をかける
      F4キーに標準モジュール記載のルーチン(SND)を割り当てる
   ・セルの値が変化したら
      1列目にコードを入力したら2列目にDBから呼び出した
      仕入先名を表示する
 というようなものです
****
Private Sub Worksheet_Activate()
  ActiveSheet.Unprotect
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True,     Scenarios:=True
  ActiveSheet.EnableSelection = xlUnlockedCells
  ActiveSheet.Protect UserInterfaceOnly:=True
  Application.OnKey "{F4}", "SND" 
End Sub
********

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SMCODE As Variant

On Error GoTo ER
With Target
  If .Column = 1 Then
'
    If .Value = "" Then
      .Interior.ColorIndex = xlNone
      .Offset(0, 1).Value = ""
      Exit Sub
    End If
'
    Set Con = New ADODB.Connection
    SMCODE = .Value
    Con.Open "DSN=TEST"
    Con.Execute ("SET NAMES sjis")
    msql = "select SNAME FROM SM01 "
    msql = msql & " WHERE SCD = '" & SMCODE & " ';"
    Set Rst = New ADODB.Recordset
    Rst.Open msql, Con
'
    If Rst.EOF Then
      .Interior.ColorIndex = 3
      .Offset(0, 1).Value = ""
      Exit Sub
    End If
'
    .Interior.ColorIndex = xlNone
    .Offset(0, 1).Value = Rst!SNAME
    Rst.Close
    Set Rst = Nothing
    Con.Close
    Set Con = Nothing
  End If
  If .Column = 11 Then
    .Offset(, 1) = Val(.Offset(, -1)) + Val(.Value)
  End If
End With
Exit Sub
ER:
  Exit Sub
End Sub
*******
全く同じ記載なので、変数だけ与えてクラスモジュールでなんとかならないかと思って、いろいろ調べたのですが、なかなか資料がみつからないので困っています
クラスモジュール以外でも、こうした重複記載を改善する手立てがありましたら
教えていただけないでしょうか。
どうぞよろしくお願いします。

1 hits

【40504】シートモジュールのクラス化 ハナ 06/7/15(土) 9:11 質問
【40505】Re:シートモジュールのクラス化 やっちん 06/7/15(土) 9:53 発言
【40507】Re:シートモジュールのクラス化 neptune 06/7/15(土) 10:48 回答
【40567】Re:シートモジュールのクラス化 ハナ 06/7/18(火) 11:23 お礼
【40516】Re:シートモジュールのクラス化 asahi 06/7/15(土) 14:12 回答
【40518】Re:シートモジュールのクラス化 Kein 06/7/15(土) 15:35 回答

41309 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free