忍者ブログ
29 March

[PR]

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

27 September

【Excel/VBA】シェイプのテキストを書き換えながら増殖させる

資料を作らねばならない→うおおお、シェイプたくさん作るのめんどうくせぇー!→モジュール作る。

沢山作りたいシェイプの書式を整えてから、それを選択した状態で走らせます。

'-----------------------------------------------------
Public Sub DupShap(Str as String)
'========================================
' 選んだテキスト付シェイプを、渡したテキストの中身で書換えながら増殖
'
' ※渡し値はカンマ区切りで頼む。
'========================================
Dim shps As ShapeRange
Dim shp As Shape
Dim wkAry() As String, i As Long

If TypeName(Selection) = "TextBox" Then

Set shps = Selection.ShapeRange    ' シェイプの複数選択のエリア管理
Set shp = shps(1)            ' こうしないとアクティブなシェイプを拾えないんだ…。
Set shps = Nothing

wkAry = Split(Str, ",")     
   ' ※専用ワークシートに貼られているテキスト、みたいな設計にしたいところを時間節約。Splitさんマジクール
    '    ・実際は、渡し値変数ではなく、実値をぶちこんだ。

For i = 0 To UBound(wkAry)

shp.Copy      ' コピー一回で済むかと思ったが、問屋がおろさなかった…。
shp.Select      ' ←これをしないと、シェイプがぴったり重なって貼られるためカオス
ActiveSheet.Paste

     ' コピー貼り付けしたシェイプを選んで、テキストを配列からセット
Set shps = Selection.ShapeRange
Set shp = shps(1)
shp.TextFrame.Characters.Caption = wkAry(i)

Next

Set shp = Nothing
Set shps = Nothing

End If

End Sub
'-----------------------------------------------------
' イミディエイト
'-----------------------------------------------------
call DupShap("先導アイチ,櫂トシキ,葛木カムイ,戸倉ミサキ")
'-----------------------------------------------------

拍手

PR
25 September

【Excel/VBA】シート上の全セル幅を縦のピクセル数に合わせる

朝っぱらから譜読みとか、眠気つおいびゃああ、ということで、久々に。

しかし、思いつきで書いてみたら、エクセルの深淵を覗いてしまった…。

【今日の勉強ポイント】
・セルの高さ、幅は、Height、Widthだけではだめで、RowHeight、ColumnWidthでないと設定できない。
・セルサイズの単位であるポイントとやらはマジ、禁断魔法

'------------------------------------------------------------------------------------------------
Public Sub morning2013_9_25(Optional ByVal WS As Worksheet)
Dim Max_Column As Long, wkWid As Double
Dim i As Long
Dim Rng As Range

If WS Is Nothing Then Set WS = ThisWorkbook.Worksheets(1)

' (((ピクセル値 * 72 / 96) - 3.75) / 6) = ポイント値
' 【参照】http://yonaizumi.dip.jp/weblog/cappe/2009/03/vba-excel-1.html

' ↓も見ました
' 【参照】http://www.excel.studio-kazu.jp/tips/0015/

Set Rng = WS.Range("A1")

With Rng

wkWid = .RowHeight * 96 / 72
wkWid = (((wkWid * 72 / 96) - 3.75) / 6)

' シートの最大カラム数を取得 ※256固定なんだけど、将来要素も見て。
Max_Column = WS.Columns.Count

Application.ScreenUpdating = False ' 画面描画停止さんマジクールです。0.3秒くらい体感早くなるよ

For i = 1 To Max_Column

.Columns(i).ColumnWidth = wkWid

Next

Application.ScreenUpdating = True

End With

Set Rng = Nothing
Set WS = Nothing

End Sub
'------------------------------------------------------------------------------------------------

拍手

12 September

【Excel/VBA】ワークブック全体か、ワークシート単品をクリアーするだけ

昨日はシートを埋めるモジュールだったので、今日はクリアーするモジュール。

デバッグ含めて10分くらいでできないかなと思ったが、20分くらいかかってた。ちぇっ

Worksheets.Countとかわざわざ格納してるのは、.Cells.Clearのところも一行でできないかなと思ったからなんだけど、考えてる間にこっちの方が簡単だってなってしまって産廃。エラーハンドラの無責任っぷりパネェので見ても真似しないでね。

あと、わざわざSet ~NothingとかRidim ~(0)とか要るの?って話なんだけど、この「モジュールごとのメモリの解放は自動」というエクセルの仕様が割と胡散臭くて、そうでもない事があったり無かったりみたいなので、これ癖にしておかないと、ちょっと大きなツール作るときにメモリが死ぬ。

パブリックの関数や変数や定数量産しても死ぬ。経験則。

'-----------------------------------------------------------------------------
Public Sub morning2013_9_12(Workbook_Or_Worksheet As Variant)
Dim wkTgt As Object, wkTgType As Byte, i() As Long

On Error GoTo Err_Get

wkTgType = 0

Select Case TypeName(Workbook_Or_Worksheet)
Case "Workbook", "Worksheet"

ReDim i(1)

i(1) = 1
wkTgType = 2
Set wkTgt = Workbook_Or_Worksheet

If TypeName(Workbook_Or_Worksheet) = "Workbook" Then
wkTgType = 1
i(1) = wkTgt.Worksheets.Count
End If

Case Else

MsgBox "渡し値が無効です。ターゲットの判定ができません。処理は失敗しました。", , "【" & ThisWorkbook.Name & "】"
Exit Sub

End Select

If wkTgType = 1 Then

For i(0) = 1 To i(1)

wkTgt.Worksheets(i(0)).Cells.Clear

Next

Else

wkTgt.Cells.Clear

End If

Set wkTgt = Nothing
ReDim i(0)

Exit Sub
Err_Get:

Debug.Print Err.Number & " " & Err.Description
Resume Next

End Sub
'-----------------------------------------------------------------------------

拍手

11 September

【Excel/VBA】階段状に色を塗るだけ。

何故、会社の席に座った途端条件反射で眠気が走るのだ。おかしいではないか。
ド_トールの椅子ではそんなことないのに。

[仮説]
ド_トールの椅子→創作のための場所として儀式化してるので、覚醒度が上がる。
会社の椅子→最初は、定例マクロ動かしたりメールだらっと見てるので創造性が無く覚醒度要らない

よし、毎朝席についたら、朝一でクソモジュールを組もう。

そうか、エクセル(2k)のカラーインデックスは56までか。勉強になった。
あと、今日の話ではないが、どうでもいい豆。Forのカウンター変数が複数いるからって、配列で作ると、ネストでは使えなかったりする(デバッグで引っかかる)

'----------------------------------------------------------------------------
' イミディエイト
call Morning2013_9_11(thisworkbook)
'----------------------------------------------------------------------------

Public Sub Morning2013_9_11(WB As Workbook)
Dim i As Long, j As Long, h As Long

On Error GoTo Err_Get

h = 0
For j = 0 To 17

For i = 0 To 56

With WB.Worksheets(1).Range("A1").Offset(i + h, j)
.Value = i
.Interior.ColorIndex = i
End With

Next

h = h + 1

Next


Exit Sub
Err_Get:

Select Case Err.Number
Case 1004
Resume Next
End Select

End Sub

'----------------------------------------------------------------------------

拍手

05 June

【VBA/Access2003】日付に纏わる怪現象

year(date() - 誕生日)-1900

…これで、年齢を一発で出せないかという手抜きを目論んだのだが

debug.Print year(date() - #2011/6/4#)-1900   → 2 (あってる)
debug.Print year(date() - #2012/6/4#)-1900   → 0 (おかしい)

どーしてそーなるの?!教えてマイクロソフトさん!

拍手