FC2ブログ
*admin*entry*file*plugin| 文字サイズ  

今日はVBAのお話です、先日からちょこちょこ作ってたんですが、
画像も貼っつけてて最初は特に何も考えず作ってました。
そしたら、今朝見てみるとやたらと重くなってて「あれれ?」
「もしかしてまずった?」まぁ、原因は言うまでもなく画像。
普通にコピペしてたせいで肥大化してしまった模様。ダメじゃん。

で、せっせと軽量化して容量を6割ほど圧縮することに成功
まだテスト段階でほとんど画像貼ってなかったのに・・・
それはさて置き折角なので最初からお話しようかと。

まずは、今回の目的は・・・
「Excelをデータベースとして使う」です

とある管理をするよう遣わされたので、そのデータベースを
Excelで作ろうとしているわけです。これは私の勝手な方針です。
一応、「こんなの作るよ」ってその一覧のデモを提示したんですが、
ぶっちゃけた話、この一覧だけあっても何の役にもたたんのですよ。

ただの紙に書いているのと変わらないので、ちょっとだけ工夫します。
それが、今回VBAを使うきっかけになったわけです。ほぼ独断ですが
「VBAで何すんねん」という話なんですが、とりあえずこれはいるかな?

・登録(データベースに追加/修正)ができる
・検索をして必要なデータを抽出できる
・その他、データベース管理に必要なこととか諸々

とりあえず、作ってみたのがこれ。
(最上部が登録と検索用のセルでそれ以下がデータベース)

適当にボタンつくる

Sub Registration()
    Dim i As Integer
    Dim Tx As String, Tx2 As String, Tx3 As Integer, Tx4 As String
    Dim tmp As Long, tmp2 As Long
    Dim f As Boolean
    Dim Code As String

    f = False
    Tx = "A5"
    i = 5
    
    Do Until Range(Tx).Value = ""
        Tx = "A" + CStr(i)
        i = i + 1
    Loop
    
    Tx3 = i - 2
        
    For i = 5 To Tx3 Step 1
        Tx = "C" + CStr(i)
        If Range(Tx) = "" Then
            Exit For
        ElseIf Range("C2") = Range(Tx) Then
            tmp = MsgBox(Range("C2") + "  は既に存在します。" + vbNewLine + "          上書きしますか?", vbOKCancel, "上書き確認")
            If tmp = vbOK Then
                f = True
                Exit For
            Else
                Exit Sub
            End If
        End If
    Next i

    If Len(Range(Tx)) <> 10 Then
        MsgBox "コード値が正しくありません" + vbNewLine + " 再度入力してください", vbOKOnly + vbCritical, "Error"
        Exit Sub
    End If

    If f = False Then
        tmp2 = MsgBox(Range("C2") + " を追加登録しますか?", vbOKCancel, "追加登録")
    End If

    If (tmp = vbOK Or tmp2 = vbOK) Then
        Range("A2:Q2").copy
        Tx = "A" + CStr(i)
        
        If f = True Then
            Tx2 = "I" + CStr(i)
            Call ShapeDelete(Tx2)
            Tx2 = "O" + CStr(i)
            Call ShapeDelete(Tx2)
        End If
        
        Range(Tx).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        
        Select Case Range("I2").Value
            Case "****"
                Tx4 = "\******.PNG"
        End Select
        
        Range("I" + CStr(i)).Select
        Call AddPictureLink(Tx4, 32, 14, i)
        
        Code = "\*****\" + Range("C2").Value + ".PNG"
        Call AddPictureLink(Code, 6, 4, i)
        
        Range(Tx).Select
    Else
        End If
End Sub


詳細は書けないので画像はもじってますが、ソースは
ほぼまんまです。まぁ、たぶん問題ないでしょ。

これは、「登録」のボタン用に作ったものです
中身見てもらったらわかると思うけれど、全然大した処理は
していません。適当に拾った数値弄ってることばっかです。

ソースもネットと本からの拾い物ばかりだし、私ほとんど
何もしてないよねぇ・・・ってちょっと虚しい感じがorz
このソースは一部ですが飛んでるところも一応あります

やってる処理はたぶんこんな感じ?

まず現在の登録数をカウント→適当な変数にセット
→重複データがないか確認→上書きか追加の確認を問う
→条件によってそれぞれデータ書き込み

カウントの時に処理挟んでもいいんだけど、最初に登録数
分かってた方が何かと都合いいかにゃ・・・?とか思ってみたり。
画像貼っつける処理もしてるのでちょっと長くなってますが。
まぁ、ここで冒頭の問題もありまして今日書き換えましたけど。
コピペだと肥大化するのでディレクトリからわざわざ
引っ張ってきてます、画像の有無とかの処理も挟んだりして。

まぁ、こんな感じで作っているわけですが、やってみた感じ
やはり必要そうな処理は大体できそうな予感
やってることがただの数値処理ならそうそうできないことは
でてこないんじゃないかなぁ・・・って勝手な妄想。

たったこれっぽっちのソースでこんなに長くなるなんて、
もっと細かく区切ったほうがいいのかなぁ・・・
というか、これぐらいのソフトならそこら辺に転がってんじゃね?



携帯変えて支払いを一括にしたら来月の支払い金額が
200kを超えているんだけど・・・パソコン買おうと思ってたのに(>ω<;)


スポンサーサイト



Mithril

Author:Mithril


趣味は主に雑学です。
どうでもいいこと書いてます。

Blenderやプログラムに
ついても書いたりするかも。
私のPC環境はこちら

メールはこちらから↓
mithrilp★yahoo.co.jp
(★を@に変えて下さい)

04 | 2012/05 | 06
- - 1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31 - -
QRコード