SQLの窓

2018年03月08日


Excel で 角丸四角形や1つの角を切り取った四角形で、角丸や切り取った長さを一定に設定する為の VBA Sub プロシージャ

インターネットで探していたら、『角丸四角形シェイプのコーナーRをミリ指定する』というコードを見つけたんですが、もっと簡素化できるので。

Sub adjust_box()
 
    Dim target As Shape
     
    For Each target In Selection.ShapeRange
    
        target.Adjustments.Item(1) = 10 / target.Height
        
    Next
 
End Sub
10 の部分を適当に変更すればいいと思います。登録場所は ThisWorkbook で、オブジェクトと選択の表示で対象オブジェクトを CTRLキーを押しながら複数選択して、Alt+F8 でマクロダイアログを表示して Enter で。

Adjustments.Item プロパティ (Excel) によると、『引数 Index で指定された調整値を取得または設定』だそうで、マクロの記録を使って動かしてみると、Adjustments.Item(1) にデータがセットされていました。

※ Sub プロシージャ は値を返しません



posted by lightbox at 2018-03-08 15:24 | VBA | このブログの読者になる | 更新情報をチェックする

2017年11月27日


Excel の VBA : ブックを開いたら、フォームを表示してボタンをクリックしたらセルにデータをセットする

まず、VBA のコードを記述するのに、オプションで開発タブを表示するようにします。



そして、マクロ有効ブックとして保存します



次に、開発タブより『コードの表示』をクリックしてコードを表示します



ユーザフォームを追加して、フォームにボタンを作成します





ボタンを追加するツールウインドウを閉じた場合は、フォームをクリックして選択し、表示メニューより選択して表示させます



ボタンをクリックした時の処理を記述するため、フォームのボタンをダブルクリックしてクリックイベントを表示させ、まずテストの為にメッセージボックスを表示させるコードを記述します
MsgBox ("テスト")
ブックを開いた時にフォームを表示させる為に、ThisWorkBook をダブルクリックしてエディタを表示させ、Open イベントを選択して以下のように記述します ここまでで保存して、いったん Excel を終了させてから再度開き、フォームが表示される事を確認します 最後に、ボタンのイベントに以下のコードを追加してセルへのデータ転送のテストを行います
Private Sub CommandButton1_Click()

    MsgBox ("テスト")
    
    Dim Youbi(8) As String
    
    Youbi(1) = "日曜"
    Youbi(2) = "月曜"
    Youbi(3) = "火曜"
    Youbi(4) = "水曜"
    Youbi(5) = "木曜"
    Youbi(6) = "金曜"
    Youbi(7) = "土曜"
    
    Dim I As Integer

    For I = 1 To 7
    
        Worksheets("Sheet1").Cells(I, 1).Value = Youbi(I)
    
    Next
    

End Sub





posted by lightbox at 2017-11-27 10:52 | VBA | このブログの読者になる | 更新情報をチェックする

2017年08月10日


VBA : Microsoft Access(.accdb) の読み込み

Microsoft.ACE.OLEDB.12.0 を使用しているので、.accdb も .mdb も読み込めます。内容は、昔ながらの記述で特別なところはありません。実行すると、Sheet1 にデータが全てセットされます。

※ データの先頭に、シングルクォートをセットしているので、全て元データのままセルで表示されます。
Sub ボタン1_Click()

    Dim objCn As Object
    Dim objRs As Object
    Dim strConnection As String
    Dim strQuery As String
    Dim strBuffer As String
    Dim nRow As Integer
    
    
    Set objCn = CreateObject("ADODB.Connection")
    Set objRs = CreateObject("ADODB.Recordset")
    
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\user\lightbox\販売管理C.accdb;"
    
    On Error Resume Next
    objCn.Open strConnection
    If Err.Number <> 0 Then
        MsgBox "1:" & Err.Description
        Exit Sub
    End If
    On Error GoTo 0

    strQuery = "select * from 社員マスタ"

    On Error Resume Next
    objRs.Open strQuery, objCn
    If Err.Number <> 0 Then
        objCn.Close
        MsgBox "2:" & Err.Description
        Exit Sub
    End If
    On Error GoTo 0

    nRow = 0
    Do While Not objRs.EOF
    
        nRow = nRow + 1
        For i = 0 To objRs.Fields.Count - 1
            Worksheets("Sheet1").Cells(nRow, i + 5).Value = "'" & objRs.Fields(i).Value & ""
        Next
        
        objRs.MoveNext
    
    Loop

    objRs.Close
    objCn.Close
    
    Set objRs = Nothing
    Set objCn = Nothing
    
End Sub






タグ:VBA マクロ EXCEL VB
posted by lightbox at 2017-08-10 10:44 | VBA | このブログの読者になる | 更新情報をチェックする

2017年08月06日


VBA : livedoor お天気API の JSON データを読み込んで利用する

InternetExplorer.Application 経由で JSON.parse を使用する方法 で、JSON 文字列をパースする方法は既にありますが、実用としてはプロパティを文字列段階で置換して、VB の予約語から排除する必要があります。その為に RegExp(VBScript.RegExp) を使用して _data をプロパティに付加します。

Sub ボタン1_Click()

    Dim objHttp As Object
    Dim strResult As String
    Dim objJSON As Object

    Dim lResolve As Long: lResolve = 60& * 1000
    Dim lConnect As Long: lConnect = 60& * 1000
    Dim lSend As Long: lSend = 60& * 1000
    Dim lReceive As Long: lReceive = 60& * 1000
    
    Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
    ' Livedoor のお天気情報(大阪)
    Call objHttp.Open("GET", "http://weather.livedoor.com/forecast/webservice/json/v1?city=270000", False)
    Call objHttp.setTimeouts(lResolve, lConnect, lSend, lReceive)
    Call objHttp.Send
    
    strResult = objHttp.responseText
    
    Set objReg = CreateObject("VBScript.RegExp")
    
    ' 全て置換
    objReg.Global = True
    ' パターン : () はサブマッチの範囲
    objReg.Pattern = """([^""]+)"":"
    
    ' $1 がサブマッチした文字列
    strResult = objReg.Replace(strResult, """$1_data""" & ":")
    
    Set objJSON = Parse(strResult)
    
    Set objHttp = Nothing
    
    MsgBox objJSON.title_data & " | " & objJSON.description_data.text_data

End Sub

Function Parse(json As String)

    Dim doc As Object, result As Object

    Set Ie = CreateObject("InternetExplorer.Application")
    Ie.Navigate ("about:blank")
    
    Do While Ie.Busy
        ' 100 ミリ秒
        Wscript.Sleep 100
    Loop
    
    Set doc = Ie.document
    
    doc.write "<script>document.JSON_Parse=function(s) {return JSON.parse(s);}</script>"
    
    Set Parse = doc.JSON_Parse(json)
    
    Ie.Quit
    
    Set Ie = Nothing

End Function






タグ:VBA VB EXCEL
posted by lightbox at 2017-08-06 00:13 | VBA | このブログの読者になる | 更新情報をチェックする

2017年08月01日


VBA : シートの保護と部分的なセル入力の許可

現実問題として、Excel で運用を目的とした定型フォーマットのワークシートを用意しても、使用者が勝手にフォーマットを変えて混乱するという事は普通に起きます。その際、『シートの保護』を利用すると、パスワード無しではなにもできない状態にする事が可能です。

ただ、その際にも定型フォーマットの目的である機能は果たさなければならないので、部分的に入力可能にする必要があります。



その為には入力対象のセルに対してロックのチェックを外すという操作が手作業の場合は必要ですが、VBA で実行すると以下のようになります
    ' ********************
    ' データ処理をする Sheet
    ' ********************
    Dim objSheet As Worksheet

    On Error Resume Next
    Set objSheet = Worksheets("処理したいシート名")
    On Error GoTo 0


    ' ロック解除
    For I = 1 To 31 * 2 Step 2
    
        ' ロック解除(9行目のC列から開始して2行毎に1ヶ月ぶん)
        objSheet.Cells(I + 8, 3).Locked = False
    
    Next


また、VBA でワークシート内を変更する場合は、やはり保護されているとエラーとなるので処理の前で保護を解除し、処理の後で再度保護します。
    ' 保護を一旦解除
    objSheet.Unprotect "パスワード"
    
    ' 入力リストの解除とロック化
    For I = 1 To 31 * 2 Step 2
    
        objSheet.Cells(I + 8, 3).Validation.Delete
        Call objSheet.Cells(I + 8, 3).Validation.Add(xlValidateInputOnly, xlValidAlertStop, xlBetween)
        ' ロック
        objSheet.Cells(I + 8, 3).Locked = True
        
        ' クリア
        If objSheet.Cells(I + 8, 1).Value <> "" Then
            objSheet.Cells(I + 8 + 1, 4).Value = ""
            objSheet.Cells(I + 8 + 1, 8).Value = ""
        End If
    
    Next
    
    ' シート保護
    objSheet.Protect "パスワード"


このように、セル単位の設計をしておけば VBA で保護フォーマットを作成する事はとても容易に可能です。





タグ:VBA EXCEL VB
posted by lightbox at 2017-08-01 19:39 | VBA | このブログの読者になる | 更新情報をチェックする

2017年07月25日


VBA : 挿入した『テキストボックス』にアクセスする



テキストボックスを挿入して、『オブジェクトと選択の表示』で一番下へ持って行って、コレクションの先頭に来るようにします( コレクションを For Each してもいいですが、ストレートに )

処理
Sub ボタン3_Click()


    MsgBox ActiveSheet.Shapes(1).TextFrame2.TextRange.Text
    
    Dim json As String
    
    json = "{" & vbCrLf
    json = json & vbTab & """link"": ""https://www.google.co.jp/""," & vbCrLf
    json = json & vbTab & """name"": ""Google""" & vbCrLf
    json = json & "}"
 
    ActiveSheet.Shapes(1).TextFrame2.TextRange.Text = json
  
  
End Sub

Form を使うのは面倒ですし、今時 Form でも無いだろうし、セルとこの方法でたいていの入力はまかなえると思います。

Shape オブジェクト (Excel)





タグ:VB VBA EXCEL
posted by lightbox at 2017-07-25 02:08 | VBA | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します
container 終わり

フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり