Quantcast
Channel: 午後わてんのブログ
Viewing all 420 articles
Browse latest View live

雨降りすぎ、トマト(レッドオーレ)葉っぱの周縁部が黒くなった、スイートバジル37日目、ムカデの撮影

$
0
0

一週間前の2015/06/27
イメージ 23
↓一週間後の今日2015/07/04
イメージ 1
定植してからはどんどん大きくなるなあ
種まきから54日目

イメージ 21
↓二日後
イメージ 2
実が大きくなっている!

イメージ 3
下から

2番めに定植した株
イメージ 22
↓二日後
イメージ 4
ほぼ同時に2つ咲いた片方だけ大きくなって
もう片方は大きくなる様子がない


一週間前と比べてみた
最初に定植した株
イメージ 24
37センチが
イメージ 5
50センチ

二番目
イメージ 25
35センチが
イメージ 6
45センチ

三番目(最後)の株
イメージ 26
定植前は27センチ
肥料が足りない状態だった
新しく出てきた葉っぱが大きくならなくて、株全体が赤黒くなる
下側の葉っぱがどんどん黄色くなる
イメージ 7
37センチ
丈も伸びたし葉っぱも緑色、新しく出てきた葉っぱも大きく育っている

イメージ 8
一番大きな葉っぱと言うか枝?30センチ

イメージ 9
昨日の雨で泥はねがひどい

イメージ 10
イメージ 11
葉っぱの周縁部が黒くなっている

イメージ 12
イメージ 13
取り除いた

イメージ 14
他にもみてたら下側の葉っぱはで周縁部が黒く腐っているようなのがあるので

イメージ 15
イメージ 16
これも取り除いた
薄茶色の斑点は苗の頃にアザミウマ類にかじられたものだと思うけど
周縁部の黒くなっているのは一昨日には見られなかったから
昨日の雨で腐ったのかも

イメージ 30
上には新しくて大きな葉っぱが付いているから多分大丈夫

イメージ 17
イメージ 18
きたない

イメージ 19
イメージ 20
風は弱かったけどかなり降ったみたい
昨日だけで86ミリ降って去年と一昨年の一ヶ月分を越えた
一昨年の7月は殆ど降らなかったんだなあ

スイートバジル、種まきから37日目
イメージ 27
こっちもどんどん大きくなる

イメージ 28
葉っぱの一部が黒ずんでいる、これも雨のせいかな

イメージ 29
やっぱり脇芽が伸びてくるのが早いよ


ムカデ
イメージ 32
多分ここだけで10匹は居ると思われるムカデ
やっと写真撮れた

イメージ 31
これは体長2センチくらいのムカデ
これくらいなら刺されても大したこと無いみたいだけどねえ
大きなプランターだと5匹くらいは居そうな感じ
土の上の石やポリポットを避けたり雑草を引き抜いた時に見かける
動きが早くてすぐに土の中に潜ってしまうのでなかなか撮れなかった
10センチを超える大きなのは年に一回くらい見かける
個人的には絶滅して欲しい種
居ないと生態系的に困ることもあるのかなあ



午後のパレットその38、見出し付きテキストボックス作成時に文字を1.2倍、本文中央位置、高さをセルに合わせる

$
0
0

イメージ 1
赤色のところが増えたところ
それぞれにチェックを入れてテキストボックスを作成する

左がチェックなしの状態で作成したもの
イメージ 2
見出し文字1.2倍

イメージ 3
本文も中央配置

イメージ 4
高さをセルに合わせる


イメージ 5
この状態で影付き3を押すと

イメージ 6
こうなる

イメージ 7
できあがったテキストボックスを並べてみたところ

背景無色
イメージ 8
背景無色はテキストボックスの背景を塗りつぶしなしで作成する
文字色が白だと見えにくいので黒にして
影付き2を押すと

イメージ 9
塗りつぶしなしのテキストボックスができあがる

イメージ 10
背景は塗りつぶしなしの透明になるけど
枠と枠の影、文字の影は色がついたまま


今知った
イメージ 11
テキストボックスに表示する文字にセルアドレスを指定すると
そのセルとリンクする
画像はテキストボックス35にB1セルを指定した状態

イメージ 12
テキストボックスを選択してから数式バーに=B3と入れて決定すると

イメージ 13
テキストボックスの内容がB3と同じになる
この前の記事でグラフにタイトルを入れる方法がわからなくてググったら
セルを指定できるってのがあって
テキストボックスにも同じようにしたらできた
エクセルに先回りされてた感じだw

今度は
イメージ 14
見出しの図形、正方形を選択して

イメージ 15
数式バーに=a3と入れて決定したら

イメージ 16
こうなった
白文字が黒文字になって太字も普通になった
ってことは文字の書式はセルのものが反映されるみたい
文字の配置は元の図形の時のまま中央配置だなあ
面白い


ダウンロード
ファイル名:午後のパレット_20150629.xlam

午後のパレットその39、エクセル2007より昔のパレットの配色を登録、見出し付きテキストボックスを最寄りセルへ移動

$
0
0

イメージ 1
午後のパレットのマイパレットを5から10枚に増やした

イメージ 2
エクセル2007より前のエクセルのパレットを再現したものを
マイパレット9に登録してみた
懐かしい色の配置だなあと思っていたら

イメージ 3
2007でもあって、コメントの書式設定だと出てくるみたい

Office TANAKA - グラフ[ColorIndexプロパティと色パレットについて]
ここを見たら色の番号と位置が載っていたので
イメージ 4
セルに番号を入れて、番号を入れたセルを選択してから

Sub oldcolor()
    Dim R As Range
    For Each R In Selection
        R.Interior.ColorIndex = R.Value        
    Next
End Sub

これを実行すると
イメージ 5
こうなって
午後のパレットとは行列数が違うから

イメージ 6
一番下の行を右側に移動してからマイパレットに登録した
登録方法は
エクセル2007アドイン作成その25、HSLのHとSを固定してLを変化させてグレースケールのYを使って色作成 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
エクセル2007アドイン、セルの塗りつぶしとフォントのパレット作ってみた、その23、罫線も追加 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ



午後のツール(午後の道具)
イメージ 7
赤い四角が増えたところ

見出し付きテキストボックスを作成するとき
イメージ 8
フォントカラーの本文の自動にチェックを入れて作成すると
本文のフォントカラーが
背景色の明るさ(輝度)によって自動調整された色で作成される
RGB表現だとRGB(128,128,128)からRGB(0,0,0)の間
イメージ 9
あんまり変わらないなwでも気分が大切



最寄りセルへ移動
イメージ 10
こんな状態のとき

イメージ 14
移動させたい図形を選択してから
最寄りセルへ移動ボタンを押すと

イメージ 11
こうなる
見出し付きテキストボックスの左上の位置から一番近いセルの左上に
ピッタリになる位置にテキストボックスを移動させる


高さをセルに合わせるボタンは
イメージ 13
見出し付きテキストボックスを選択してから押すと

イメージ 12
こうなるボタン
最寄りセルへ移動して、
さらにテキストボックスの下側を一番近くのセルまで広げて
文字の縦配置を中央にする
うーん、これは最寄りセルには移動させないほうがいいかな

イメージ 15

ダウンロード
ファイル名:午後のパレット_20150705.xlam

午後のパレットその40、午後のツールで見出し付きテキストボックス作成時にセルを指定できるようにした

$
0
0

イメージ 1
赤の四角が追加したもの、青の四角が動作の変更

高さをセルに合わせるの動作の変更
イメージ 2
昨日はテキストボックスの位置もセルに合わせていたけど

イメージ 3
位置を変えずに下側を伸ばして合わせるだけにした


本文をセルとリンク
イメージ 4
本文をセルとリンクにチェックを入れて作成すると
本文のフォントカラー指定は無視されて元のセルと同じフォントになる
内容もリンクしているのでセルの内容を変更すると

イメージ 5
テキストボックスの表示も変化する

イメージ 6
リンクするのは値だけみたいで
セルのフォントや色、サイズを変更しても無視される
けど
イメージ 7
本文のテキストボックスを選択してから

イメージ 8
数式バーにカーソルを置いて決定すると

イメージ 9
変更が反映されるみたい
このへんの動きはよくわからないなあ

午後の色作成
イメージ 10
以前は複数のセルを選択していても色が変わるのは
アクティブセルだけだったけど
不自然な気がしたのですべての選択セルの色が変わるように変更した


ダウンロード
ファイル名:午後のパレット_20150706.xlam


3日間雨が降り続けた後のトマト(レッドオーレ)とスイートバジルの様子

$
0
0
雨ばかり

イメージ 27
6月もたくさん降って160ミリだったのに
今月は一週間で180ミリも降って、今日も午後から雨の予報

イメージ 28
日照時間は一週間で2時間!

トマト(レッドオーレ)は種まきから58日目
イメージ 2
↑4日前↓今日2015/07/08
イメージ 1
やっと雨が上がったので撮影できた

イメージ 3
A株(最初に定植した株)、二本伸びている枝の左が脇芽が成長した枝で
右が脇芽じゃない元の枝、幹?

イメージ 4
左がB株(二番目に定植した株)
右の青い鉢のがC株(3番目に定植)

A株
イメージ 5
上から

第一花房
イメージ 6
↑四日前↓今日
イメージ 19
4日間で結構大きくなるんだなあと
3日間雨が降り止まなくて写真撮るのがめんどくさくて撮影できなかったけど
途中経過見たかった

第二花房
イメージ 8
開花しそう

イメージ 9
第3花房

イメージ 10
成長した脇芽の先端部分
花房はやっと1つ出てきたところ
脇芽じゃない方は同じ長さで2つ花房が付いている

イメージ 11
コナジラミ、やっぱりたまに見かける

B株
イメージ 12
新しく出てくる葉っぱの成長が遅くなった気がする

B株第一花房
イメージ 7
↑4日前↓今日
イメージ 13
一つだけ目立って大きくなっていた
A株に比べると元気ない?追肥しようか迷い中

イメージ 14
第二花房と第三花房
A株に比べると葉っぱが小さいなあ

イメージ 15
また初めて見る虫

イメージ 20
イメージ 21
調べてみたけどわからない
触覚みたいに前方に伸びているのは脚かな?

C株
イメージ 16
まだ小さいねえ

イメージ 17
それでも開花

イメージ 18
根本の土を見たら根が見えていた
定植したのが10日前、ここまで伸びるんだなあ
この鉢の大きさでは小さいってことか

トマト(レッドオーレ)は種まきから58日目

スイートバジル、種まきから41日目
イメージ 22
イメージ 23
また大きくなった

イメージ 25葉っぱの色が薄いところと濃いところがある
雨のせいかな(何でも雨のせいにしておこうという風潮)

イメージ 24
ここまで大きな葉っぱは初めて

イメージ 26
根本のマルチの隙間から雑草が伸びてきた
マルチをしていなかったらこれが全面に生えているんだよなあ
マルチングしておくとラクができる

午後のパレットその41、午後のツールで選択セルの塗りつぶしの色のHSLを変更できるようにした

$
0
0
午後のツールの色表示タブ
イメージ 1
赤の四角のところが追加したボタン6つ

選択セルの色を変える
  • +H色相を+15度、+15して360を超えたら-360する
  • +S彩度を+5、+5して100を超えるときは+5しない
  • +L明度を+5、+5して100を超えるときは+5しない
マイナスもそれぞれ同じ数値をマイナスする

イメージ 2
水色RGB(0,255,255)で塗りつぶされたセルを選択して
+Hを押すと

イメージ 3
色が変わる

イメージ 4
色相を確認すると180+15=195になっているのがわかる
また、選択セルそれぞれの色が対象になるので

イメージ 5
違う色をまとめて選択して押すと

イメージ 6
それぞれの色の色相が変化する

彩度を-5してみる
イメージ 7
色を水色に戻したこの状態で-Sを押すと

イメージ 8
100だった彩度(S)が95.2になった
本当は100-5=95なんだけどHSLとRGBの変換時に誤差が出るみたい
これは仕様かなあ
あと変換後に0から100の間に収まるように制限しているから
今の状態から+Sを押しても元の色に戻らないことになる
95.2+5=100.2で100を超えるから+Sを押しても元の100にはならない
これは変更しようかな

明度(L)
イメージ 9
-Lを押すと

イメージ 10
明度(L)が50から45に変化する
これも彩度と同じように誤差が出るはず
色相も同じで黒や白に近い色だと誤差が大きくなる

使い所?
イメージ 11
水色のパレット作った
青のパレットも作りたくなった時
最初から作るのはめんどくさい

イメージ 12
一旦セルに書き出して
青の色相は240だから水色の180に60足せばいい

イメージ 13
+Hを4回押せば15*4=60で青になる
…でも微妙に違うな、Rが0じゃなくて1になっている

イメージ 14
適当に空いているマイパレットに一括登録でできあがり

ダウンロード
ファイル名:午後のパレット_20150708.xlam

トマトとスイートバジルのプランター栽培、トマトに追肥、バジルにもコナジラミ、脱皮途中のダンゴムシ

$
0
0

トマト(レッドオーレ)種まきから60日目
イメージ 14
左からB,C,A株

イメージ 6
A株を上から

イメージ 7
B株を上から
A株に比べて元気が無い気がするので

イメージ 8
少し化成肥料(8-8-8)で追肥することにした

イメージ 9
イメージ 10
ゴミとか雑草入れに使っているポリポットを避けた後の土に
白いたくさんの根が見えた
ここに定植したのは17日前、ここまでたくさん伸びるんだなあ
もっと大きなプランターで育ててみたい

イメージ 11
化成肥料パラー
根に直接当たるのはよくなさそう
今気づいたけど左下にムカデが写っている

ダンゴムシ
イメージ 12
イメージ 13
イチゴ苗のポリポットを避けたら
半分脱皮したダンゴムシが居た
脱いだ殻(皮?)らしきものも近くにある

コバエ?眼が赤い虫
イメージ 25

キイロショウジョウバエ
ここに載っているキイロショウジョウバエに似ている


イメージ 15
A株第一花房、トマトだ!

イメージ 16
第二花房、開花が始まった
トマト栽培の画像でたくさんの実が付いたのを見るけど
順調に育つとどんどん花が咲くんだなあ

イメージ 17
コナジラミ!
このぶんだと今年もトマト黄化葉巻病になるのは時間の問題だなあ
それまでに収穫できるまで育って欲しい

イメージ 18
たまたまめくった葉っぱに蜘蛛
トマトの様子を見に行くたびに蜘蛛の巣に引っかかるくらい
蜘蛛もたくさんいる
コナジラミとかも捕食しているのかしら

イメージ 19
葉っぱの枝が下に垂れ下がっているのが気になる
だんだん垂れ下がってきた

イメージ 20
B株、第一花房
最初の開花はA株と同じだったんだけどねえ
病気になったとは思いたくないw
ので追肥した次第

イメージ 21
同じく第二花房
こっちも開花が始まった

イメージ 22
C株第一花房、最初の花は咲き終わって2つ目が開花

イメージ 23
植える土が無くなって小さな鉢に定植したからどう違いが出るか
こっちも追肥しようかなあ


イメージ 24
スイートバジル

イメージ 1
雑草を食べた虫のフンがスイートバジルの葉っぱの上にたくさんある
アブラムシも雑草にいくつか付いている
バジル類はアブラムシ避けになるとか見たことあるんだけどなあ
それでもスイートバジル自体は虫から好かれていない

イメージ 2
最近気づいたのがコナジラミはバジルでも寄ってくる
ってことはコナジラミ避けにバジルは効かないというかむしろ呼んじゃうのかなあ

イメージ 3
もう一匹居た!

イメージ 4
脇芽

イメージ 5
成長点に近いこんな上のほうからも脇芽が出てくる


Pixtack紫陽花2.7.96.188_いくつかの不具合修正、プログラム名が正しく入るようにした

$
0
0

2015/05/19
以下の時エラーになっていたのを修正
テスト機能の図形2で「マウスで」のボタンを押してから図形を描かないで終了ボタンをおした時
イメージ 1
マウスで図形描画しようとしてやっぱやめたって終了すると

イメージ 2
エラーになっていたのを修正



2015/07/10 2.7.96.188
保存ボタン以外で画像をJpeg形式で保存した時にソフトウェア名が入っていなかったのを修正
記入するソフトウェア名をPixtackからPixtack紫陽花に変更した
イメージ 3
Pixtack紫陽花で保存したJpeg形式の画像のプロパティの詳細
ここで表示されるプログラム名をPixtackからPixtack紫陽花に変更した

イメージ 4
画像を右クリックからの保存メニューと

イメージ 5
選択範囲を保存の時にプログラム名が入っていなかったのを修正

虫の名前を調べるときに役に立ったところの1つが
写真共有サイト「フォト蔵」
自分の写真を共有するのものいいなあって思って
わてんさんの写真 - 写真共有サイト「フォト蔵」
を作った
イメージ 6
アップロードした画像にExifが在ればそれも一緒に表示される
その中に使用ソフトウェアの項目がある
Pixtack紫陽花で加工した画像なのに空白になっているのを見て
今回の修正につながった次第

ダウンロード
ファイル名(64bitウィンドウズ専用):Pixtack紫陽花_20150710_x64.zip
ファイル名(32bitウィンドウズ用):Pixtack紫陽花_20150710_x86.zip
(ヤフーボックス)


トマト(レッドオーレ)種まきから62日目で黒マルチした

$
0
0

7月降水量
イメージ 2
一昨日までの11日間毎日降っていた

イメージ 23
左からB株、C株、A株

イメージ 1
トマトも大きくなるけど雑草も伸びるので
黒マルチをすることにした

イメージ 3
真ん中辺りまで切れ目を入れたビニールシートを

イメージ 4
イメージ 5
被せて洗濯バサミで固定

イメージ 6
雨が降った時に中央に流れ込まないようにしてみたけど
どうなるかなあ

イメージ 7
トマトB株はイチゴと混植のプランター
このままだとうまくマルチングできそうにないので

イメージ 8
このランナーを切断

イメージ 9
分離して

イメージ 10
なんとかごまかした

イメージ 11
でもこれはイチゴのところが低くなっているから
雨が降ったらイチゴのところに雨水が集中しちゃうなあ

青い鉢のC株
イメージ 13
↑定植時
イメージ 12
2週間放置でこうなった

イメージ 14
適当に覆って洗濯バサミで固定

イメージ 15
OKできた
黒マルチで期待する効果は
雑草が生えてくるのを防ぐのと
土から水の蒸発を抑えること
除草と水やりがめんどくさいってのが理由
イチゴの時はいくつか弊害があったけどトマトではどうなるかな
ホームセンターとかで販売されている防草シート
水も透過する便利なものみたいだけど値段高かった
10メートルで2000円とか

A株
イメージ 16
イメージ 17
第一花房、右の大きな実は一昨日と比べて大きくなっている感じがしない
レッドオーレはこれくらいの大きさなのかなあ
中玉トマトっていうからもう少し大きなのを想像していた
この房で開花したのは8個になりそう

イメージ 19
10日前の葉っぱの色
イメージ 18
葉っぱの色が緑だったのが赤茶色になっている
B株に続いて追肥しようかな

イメージ 20
3日前に追肥したB株
こっちは葉っぱの色じゃなくて葉っぱが大きくならない気がして追肥した
けどあまり変化がない感じ

イメージ 21
実の方は大きくなっている

イメージ 22
この房は4つの実と2つの花、1つの蕾の合計7個になりそう

イメージ 29
B株、C株

C株
イメージ 24
やっと最初に開花したのが咲き終わったところ

イメージ 25
これも葉っぱが赤くなっている

イメージ 26
コナジラミ
最近増えてきて今日は3匹確認した

イメージ 30
ヒメセアカケバエ
これかなあ
こっちかも
1枚撮って別角度から撮ろうとしてたら逃げられた

種まきから45日目、スイートバジル
イメージ 27
イメージ 28
近いと画面に収まらなくなってきた


トマト黄化葉巻病になったかもで去年と比べてみた、スイートバジルの黒マルチの下の土の様子

$
0
0
7月の最高気温
イメージ 41
暑いと思っていたけど一昨年の連日35度に比べたら全然涼しかったw
連日35度ってすごいな

トマト(レッドオーレ)種まきから65日目
イメージ 2
↑一昨日↓今日
イメージ 1
2015/07/11から雨が降っていなくて、今日で5日目
昨日一昨日と最高気温が31度を超える暑さで今日も超えそう
マルチングしたこのトマトには6日前から一回も水を入れていない

イメージ 3
A株


もう少し葉っぱの勢いがあったほうがいいかなと

イメージ 6
マルチをめくって追肥した

イメージ 7
A株に化成肥料(8-8-8)をこれだけ追肥
量はどれくらい入れればいいかわからないので適当

イメージ 8
青い鉢植えのC株にも同じように追肥

イメージ 9
C株には少なめ


A株、第1花房
イメージ 11
↑一昨日↓今日
イメージ 12
イメージ 13
実は大きくなっている
第1花房はすべての花が咲き終わった、合計8個
最初の花が咲き始めてから20日
人工授粉していないしミツバチその他の受粉に関係ありそうな昆虫も見かけないけど実は大きくなるんだなあ
ハウスや温室でトマト栽培をしている農家の人に受粉はどうしているのか聞いたら
ミツバチを巣箱ごと購入してハウス内に置いていると言っていた
トマトの品種とかによって違うのかなあ

イメージ 14
A株、第2花房
こっちは立て続けに咲いて、全部咲いたかな?


イメージ 5
↑一昨日↓今日
イメージ 15
A株、第3花房
一個目が開花
一昨日追肥したけどあんまり変わらない感じ?

イメージ 16
A株、伸ばした脇芽の第1花房
蕾が大きくなってきた
3日後くらいに開花しそう


イメージ 4
左がB株、右の小さいほうがC株

ここからB株
イメージ 10
↑一昨日↓今日
イメージ 17
実が大きくなってくるとガクが上に反ってくるのが面白いね
B株、第1花房

イメージ 19
↑一昨日↓今日
イメージ 18
B株、第2花房

イメージ 20
↑一昨日↓今日
イメージ 21
B株、第3花房
もう少しで咲きそう、なのはいいんだけど様子がおかしい
葉っぱの枝が曲がりすぎだと思うアーチ型
茎が扁平になってきたのも気になる

イメージ 22
B株、∩ってなっている
ついにトマト黄化葉巻病になってしまったのかなあ

イメージ 23
A株のように⌒こうなってほしい

全体の形から
イメージ 24
B株は頂点付近が葉っぱが混み合っている

去年のトマト黄化葉巻病を見てみる
イメージ 33
イメージ 34
2014/08/13
この時期に開花はするけど結実しない状態
つまり発病している

イメージ 35
2014/08/19
かなり症状が進んだ状態、葉脈以外の緑色が薄くなっている

イメージ 36
イメージ 37
2014/08/21
成長点付近
やっぱり葉っぱの枝が急カーブ状になって今のB株と似ているなあ
これは確定かなあ

イメージ 38
イメージ 39
トマト黄化葉巻病の末期症状
成長が止まる


今年に戻って
C株
イメージ 26
↑一昨日↓今日
イメージ 25
イメージ 27
C株第1花房
他の株に比べて小さい、第1花房の花の数もこれを見ると6個かな?少なめ


スイートバジル、種まきから48日目
イメージ 28
↑一昨日↓今日
イメージ 29
日中でも半分以上日陰になる所においている
種をまいたとき以外、水は一回も入れていない、雨水だけ
くろまるちのちからってすげー!

イメージ 30
種まき以来の封印を解いてみることに
(中どうなってるんだろ?)

イメージ 31
見たことない虫とか出てきたら怖いとか思いつつ覗いてみたけど
なんにも出てこなかった
奥に見える白い糸みたいなのは徒長した雑草

イメージ 32
土に表面にスイートバジルの細かい根が張り巡っている
黒マルチで日光が届きにくくなっているからだろうねえ
植物が大きく育つにはたくさん根が張れるほうがいいだろうから
そういう面でも黒マルチは良さそう
ああ、でも追肥するとき根に直接肥料が触れるのは良くないかなあ
土は乾燥していなかったので水は入れなかった

去年のスイートバジル
イメージ 40
黒マルチは無かった
晴れた日は毎日水やりしても萎れることがあった


トマト黄化葉巻病ではないみたい?風強い、追肥したところに水をかけた

$
0
0
トマト(レッドオーレ)種まきから68日目
イメージ 1
↑一昨日↓今日
イメージ 2
この距離からの撮影だと枠に収まらなくなってきた
気づいたのが花房の向き
すべて同じ方角、ほぼ北側に付いている
たまたま定植するときにそうだったのかもしれないけどね
それでも株ごとには決まっているみたい?
イチゴは方角は決まっていないけど株ごとにランナーが
伸びる方向と花芽が伸びる方向は決まっているみたいに

イメージ 36


イメージ 3
横から撮影、手前がB株
昨日までは台風のせいで風が強かった

イメージ 34


A株、第1花房
イメージ 5
↑20日前↓今日
イメージ 4
レッドオーレは中玉トマト、どこまで大きくなるのかなあ

イメージ 6
上から、左から2番めが大きくなる様子がない

イメージ 7
イメージ 8
A株、第2花房
ガクの部分ごと取れてしまったものがある
去年のトマト黄化葉巻病はすべての花がこうなってしまった

イメージ 9
A株、第3花房と第4花房

イメージ 10
A株の脇芽が成長した側枝の第1花房
開花が始まった
脇芽が成長した状態のものは側枝でいいのかな
枝って言うと木みたい

イメージ 11
とりわけ沢山の蕾が付いている
他の花房は7か8個くらいでこれは15個くらい付いている

イメージ 12
B株、第1花房

イメージ 13
B株、第2花房
右上に写っている実は大きくならない、受粉できなかったのかな

イメージ 14
B株、第3花房
これは元気がある感じ、蕾を含めて12個確認できる

イメージ 16
↑一昨日↓今日
イメージ 15
新しく出てくる葉っぱの枝がクルッと丸まっていたから
トマト黄化葉巻病を疑ったけどまっすぐになってきた
咲いた花がガクの部分ごと落ちてしまうようになったら
断定しようと思っている
コナジラミは最近見ない

イメージ 17
風が強く咲き終わっていないようなものまで落ちている

イメージ 18
雌しべが見える
普段なら花が散っても雌しべは実にくっついていることが多い

C株、第1花房
イメージ 19
↑一昨日↓今日
イメージ 20
雌しべが残っているのがわかる

イメージ 21
数自体が少ない

イメージ 22
C株、第2花房
普通は幹に近い方から順番に開花するはずなのに3番めが最初に開花しそう
1,2番の蕾は花びらが見えなく咲きそうにない感じ

イメージ 23
下の葉っぱも枯れてきて肥料が足りないのかと思って
追肥したのが4日前、その効果が出ていない気がするので

イメージ 24
マルチを外して水をかけることにした
黒マルチをしたのが1週間前、雑草が全然生えていない

イメージ 25
白い粒が4日前に追肥した化成肥料
その時は水をかけなかった
水をかけて肥料を溶かさないと効果ないのかなあ

イメージ 26
水をかけ終わった後
A株も4日前に追肥したので同じように水をかけておいた

水たまり
イメージ 31
やっぱり雨が降ったらマルチに水たまりができていた
プランターのふちギリギリまで土を増やせば防げそうだけど

イメージ 32
イメージ 33
マルチの中央を上に引っ張るようにしてみた


スイートバジル、種まきから51日目
イメージ 28
↑一昨日、↓今日
イメージ 27
比べてみたらあんまり変化ないな…

イメージ 29
一番大きいので40センチ

イメージ 30
大きい葉っぱは10センチ
スイートバジルは今回で3回か4回目だけど今回はいい感じだなあ

イメージ 35
葉っぱが縮れて形が歪になるのは強風のせいかな


午後のパレットその42、午後のツールで画像付き見出し付きテキストボックスを作成するボタンを付けた

$
0
0

イメージ 1
画像付きというタブを増やしてそこに
画像付き見出し付きテキストボックスのボタンを付けた
赤色の四角がそれ

イメージ 10
この状態でボタンを押すと
↓こうなる
イメージ 2
画像付き見出し付きテキストボックスが3つできる
重なっているので広げてみると↓
イメージ 3
こうなっている
以前までの見出し付きテキストボックスに画像を加えた

イメージ 6
選択セルの値が見出しの文字になり
その右隣が本文になり
その右隣が画像になる


画像ファイルのパスが空欄の時は
イメージ 4
どの画像を挿入するかのダイアログを表示する
ここでキャンセルすると見出しや本文もキャンセルされる
画像を選択して開くを押すと

イメージ 5
画像付き見出し付きテキストボックスが作成される

挿入される画像の縦横の大きさは等倍
見出しと本文の図形は画像の横幅に合わせられる

この画像付き見出し付きテキストボックスは3つの図形をグループ化しただけで
イメージ 7
これを分解すると

イメージ 8
こうなっている
3つの図形をぴったり合うように大きさと位置を合わせているだけ
なので個別に選択した状態で移動させるとバラバラになる

イメージ 9
本文用のテキストボックスの文字を追加しているところ
右端に到達すると自動で折り返されるみたい
これは折り返されているだけで改行はされていない
行数が増えると下に広がる


画像付き見出し付きテキストボックスを
作った経緯
エクセルシートに画像を入れてたらその画像が何なのかを
説明する文章やタイトルなんかを入れたくなる
画像の近くのセルに説明文を入れるんだけどこれだと
後になってから画像を別の場所に移動したくなった時に
画像とセル両方を別々に移動するっていうめんどくさいことになる
他にも説明文が長くなってセルに収まらない時
セル幅は変更したくない
セル内改行もしたくない
セルの結合なんてもってのほか!
ってのがあって
それを解決するのがテキストボックス
これに文字を入れて画像と位置と大きさを合わせてからグループ化しましょう
なんだけどこの作業がめんどくさい
じゃあマクロで!

ダウンロード
アドインファイル名:午後のパレット_20150717.xlam


アドインの導入方法は↓だけど古いなあ

水切れラッシュ、トマト(レッドオーレ)種まきから71日目、スイートバジルは54日目の様子

$
0
0
イメージ 2
↑一昨日↓今日
イメージ 3
この距離だと全体が収まらなくなってきたので

イメージ 1
少し離れて
左からB株、C株、A株

イメージ 4
右のA株は側枝を1本伸ばしている

イメージ 5
昨日はよく晴れていて

イメージ 6
B株の葉っぱ
上側に丸まっている、昨日まではここまで丸くなかった
水が足りない?

イメージ 7
上の葉っぱはそんなの事なくて普通
それにしても以前の枝ごと丸くなったのは何だったんだろう
トマト黄化葉巻病を疑ったけど今ではまっすぐになったし
花が咲いた後もガクの部分ごと落ちてしまうこと無く実っているので
病気ではないみたい

イメージ 8
マルチを外して土を見るとカラッカラってわけじゃないかな?
でも定植してからのB株にまともな水やりは一回もしていないので
水をいれることにした

イメージ 9
2リットル入れたけど排水口からは水は漏れてこなかった
ってことはやっぱり乾燥していたみたい

イメージ 10
夕方近くのC株
午前中に見た時は気づかなかったけどしおれていた

イメージ 11
マルチを外して土を見るとかなり乾燥していた
二日前に200mlくらい入れたばかりなのにこれだけ乾燥するとは思わなかった
マルチの貼り方がいまいちだったかも

イメージ 12
水はこの容器の半分500mlも入れたら鉢底から漏れてきた
やっぱりあんまり入らないなあ

イメージ 13
イメージ 14
スイートバジルもついに水切れになってしおれていた

イメージ 15
土は見てみると乾いているけどトマトのC株ほどではないかなあ
でもこの状態だとスイートバジルにとっては足りないみたい

イメージ 16
入れた水の量は1.5リットルだったかな2リットルだったかも
これも入れた後でも排水口から漏れてこなかったので
見た目以上に土は乾燥していたのかも

イメージ 17
数時間後には元通り
種まき以来53日目にして初の水やりだった

イメージ 18
花芽が出てきた

トマトA株
イメージ 19
第1花房、大きいのは直径35mmくらい
開花から26日目
ググったら開花してから収穫までの日数は
大玉トマトで60日
ミニトマトで45日
中玉トマトのこれはその中間だとすると(60+45)/2=52.5
ってことはあと25日くらいは8月中旬
結構かかるなあ

イメージ 20
第2花房はイマイチな感じがする

イメージ 21
第3花房、咲き終わった花も出てきて見がつき始めた
これはいい感じ

イメージ 24
第4花房

イメージ 22
A株側枝の第1花房’、たくさんの花が付いている
側枝は元の枝(幹)の第1花房のすぐ下の葉っぱの枝から伸びている

B株
イメージ 23
第1花房、これも一番大きいのが35mmくらい

イメージ 25
第2花房、A株同様イマイチな気がする

イメージ 26
第3花房

イメージ 27
第4花房
上の第3、4花房は下の第1、2花房にくらべて花の数が多い

C株
イメージ 28
第1花房、大きくなってきた

イメージ 29
第2花房、やっぱり1,2番目の蕾らしきものは咲かないねえ

下の葉っぱが黄色くなったので追肥、スイートバジルも追肥と花芽が出てきたので摘心、料理メモ

$
0
0

トマト(レッドオーレ)種まきから73日目

イメージ 1
左からB株、C株、A株
ネットで見かけるトマトに比べると葉っぱが少なくてスカスカなことに気づく

イメージ 7
↑昨日↓今日
イメージ 2
A株の下の葉っぱがたった一日でこんなに黄色くなった
肥料足りないのかな?
追肥したのが9日前でこの時は水を入れなかったせいか
追肥の効果がなさそうなのを見て水を入れたのが5日前

イメージ 13
葉っぱ表、葉脈に沿って茶色くなっている

イメージ 14
葉っぱ裏、表と同じように葉脈が茶色

イメージ 3
A株主枝頂点

イメージ 4
A株側枝頂点、第2花房'も開花
元気ない感じもするけどわかんないなあ

イメージ 16
A株第1花房、ここ3日くらい大きくなっていない気がする
肥料が足りないとしてもどれが足りないのかもわからない
窒素分はあまり入れたくないので8-8-8の化成肥料よりも

イメージ 5
5-10-5の液肥を1mlを1000倍に薄めた水1Lを入れることにした
トマトにこの液肥を使うのは初めて

イメージ 6
黒マルチを外したところ
左側は昨日からの雨水で湿っているけど右側は雨水が入らないので乾燥している
右側を重点的にさっきの水1Lをかけた
これで9日前に入れた8-8-8の化成肥料もまた溶け出して
吸収されると思う

イメージ 8
イメージ 9
B株第1花房付近の葉っぱ
A株と違って黄色く放っていないけど葉脈に沿って黒くなっている

イメージ 15
これは全体的に黒くなっている

イメージ 10
B株真ん中あたりの葉っぱ
葉っぱの表面側に丸まっている
葉っぱが丸まるの原因の1つは窒素が多すぎらしいけど

イメージ 12
20150715の時のB株頂点
この成長点付近の葉っぱの枝が曲がるのはトマト黄化葉巻病と勘違いしたけど
窒素が多すぎの時の症状ってのが昨日ググっていて分かった
イメージ 11
今のB株頂点
全然曲がっていないってことは窒素は多くない?…
むしろ足りていない感じがする
追肥したのが14日前だからそろそろ2回めの追肥しようか迷い中


スイートバジル、種まきから56日目
イメージ 21
花芽が出てきたので摘心(収穫)

イメージ 17
↑前↓後
イメージ 22
あんまり変わった感じしないけど

イメージ 23
イメージ 24
結構採れたなあ

イメージ 25
葉っぱの裏に蜘蛛居た、これは収穫じゃない


栄養がいっぱいあるときは葉っぱを茂らせるけど
栄養が不足してくると花を咲かせて種をつくろうとするらしいから
それで花芽が出てきたのかも、追肥すれば花芽が出にくくなるかもで
1回めの追肥をすることに
イメージ 18
8-8-8の化成肥料

イメージ 19
マルチをめくってばらまいて

イメージ 20
水300mlを入れた
こんなことならこの前の水切れの時に追肥しておけばよかったなあw
画像見てたらこの容器の単位はccなんだな、mlとccの違いってなんだろうって
ここみたら今では違いがなくて、重さ基準がmlで体積基準がccみたいね


採れたてバジルで
イメージ 26
さっそく調理
湯むきしたトマトの下にはバジル10枚をちぎったのと塩コショウしたエビ3匹
下のお椀にはバジル10枚とピーマン一個

イメージ 28
スパゲッティのお湯をかわしつつ玉ねぎ半分とキャベツを炒めて
ダイショーの味塩コショウも入れておいて
スパゲッティを茹でつつ
キャベツに火が通ったところでピーマン投入
ピーマンに火が通るくらいでトマトを半分投入
トマトが崩れてきたら硬めに茹で上がったスパゲッティと煮汁を投入
トマトのかたちがなくなってきたかスパゲッティがちょうどいい硬さくらいで
残りのトマトとエビと細かくちぎったバジルと味塩コショウを投入
30秒位?でエビに火が通るから火を止めて

イメージ 27
皿に盛ってバジルをばらまいたところ
久しぶりに調理したから段取りとか手間取ったけど美味しくできた
やっぱりトマトは美味しいなあ
いつかは自分で育てたトマトを使って調理したい
ダイショーの味塩コショウって化学調味料も入っているから
簡単に美味しくできるのが素晴らしい

午後のパレットその43、午後のツールで画像付き見出し付きテキストボックスの見出しを画像に重ねる

$
0
0

イメージ 1
午後のツールの画像付きタブに赤枠のボタンを追加

再調整画像付きTB
イメージ 2
見出しと本文用の図形のサイズと位置を再調整
画像の幅に合わせる
位置は見出しに合わせる


最寄りのセルへ移動
イメージ 3
↑これが↓こうなる
イメージ 4
選択図形の左上を一番近くのセルの左上に合う位置に移動させる


見出しを中へ
イメージ 5
↑これが↓こうなる
イメージ 6
見出しの図形の背景色を半透明にして
画像の上に重ねる
「見出しを外へ」は
逆の動作になる

仕様
イメージ 9
見出しを中へと外へのボタンを左のような
見出しの大きさを手動で変更した図形に使うと
それぞれ右のようになる
自動調整されてしまう


画像ファイルのフルパスの取得してからエクセルへ貼り付け
イメージ 7
エクスプローラで画像ファイルのあるフォルダを開いて
画像ファイルを選択して
メニューのホームのパスのコピー
これで選択されている画像すべてのフルパスが
コピーされるので

イメージ 8
あとは普通にエクセルに貼り付けるだけ
エクスプローラで複数ファイルのフルパスをコピーできるのはさっき知ったよ
便利になったなあ、WindowXPの頃は無かったはず

イメージ 10
図形を作りたいところの見出し部分を選択して
画像付き見出し付きTBのボタンを押すと

イメージ 11
作成される

複数図形の選択
イメージ 12
選択したい図形と重なっているセルを選択してから
図形選択ボタンで

イメージ 13
図形が選択状態になる
もしくはシフトキーを押しながら図形をクリック

イメージ 14
見出しを中へボタン押したところ

ダウンロード
アドインファイル名:午後のパレット_20150725.xlam

アドインの導入方法は↓

トマト(レッドオーレ)プランターの配置変更、支柱の組み直し、花房ギャラリー

$
0
0
暑い
トマト(レッドオーレ)種まきから76日目
イメージ 1
↑一昨日↓今日
イメージ 2
狭くなってきたので場所を変えた
左からB株、C株、A株

イメージ 4
↑こうだったのを↓こうした
イメージ 3
こうしてみると無駄な作業があったなあ
左の上を長いものに変更したんだけど短いのを継ぎ足せばよかったんだな
強度的には以前のと変わらない感じ
台風以外なら大丈夫だと思う
この日は最高気温33度、作業したのは17時でこの時でも30度越えていたみたい
水の量は
A株24日2L、25日1L
B株24日0L、25日1L
C株24日250ml、25日250ml
A株のプランターはこれだけ入れてやっと排水口から少し溢れてきたくらい
C株の鉢は全然入らない

イメージ 5
C株にも支柱をたてた

20150723に液肥で追肥
20150725に化成肥料で追肥したA株
イメージ 8
イメージ 7
イメージ 6
葉っぱが黄色くなる速度が遅くなったかな?くらいの変化

イメージ 9
7/25にはこれくらいの化成肥料をそれぞれの株に入れたんだけど
黄色くなった葉っぱは回復しなかった

B株の下の葉っぱ
イメージ 10
イメージ 11
2015/07/26のぶん撮り忘れてた

A株
イメージ 27
左が側枝で第1花房の下から出た脇芽が成長したもの
そろそろ支柱が欲しくなってきた

A株第1花房
イメージ 12
イメージ 13
実の方は大きくなっている

第2花房
イメージ 16
イメージ 20
イメージ 21

第3花房
イメージ 17
イメージ 22

第4花房
イメージ 18
イメージ 23


A株、側枝第1花房'
イメージ 19
イメージ 24
この房は二股に分かれてたくさんの蕾がついた
こんなにたくさんなったら嬉しいけど摘果した方がいいのかなあ
と思いつつ放置

側枝第2花房'
イメージ 25
イメージ 26


B株
イメージ 28
昨日の移動で一番日当たりが良い場所になった

B株第1花房
イメージ 15
イメージ 14
B株は昨日が16日ぶりの追肥だった
あんまり変化ないかな

第2花房
イメージ 29
イメージ 33

第3花房
イメージ 30
イメージ 34
妙に伸びた第3花房
最初に咲いた花は落ちてしまった

第4花房
イメージ 31
イメージ 35

第5花房
イメージ 32
イメージ 36
第6花房も見えている

C株
第1花房
イメージ 37
イメージ 40
イメージ 41
数は少ないけど大きくなっている

第2花房
イメージ 38
イメージ 42
鉢が小さいせいですぐ水切れになる
黒マルチしているけど晴れたら毎日水の補給

第3花房
イメージ 39
イメージ 43
開花

葉っぱ
イメージ 48
断捨離の人に見てもらったら
捨てましょう( ^,_ゝ^)ニコッ
って言われそう

イメージ 44
A株の上の方の葉っぱ

イメージ 45
B株の上の方の葉っぱ
ABどちらも小さい気がする、もっと肥料を入れてもいいのかな

イメージ 47
A株真ん中あたりの葉っぱ
あちこち虫に食べられているけどいいと思う(素人)

イメージ 46
C株真ん中あたりの葉っぱ
トマトの葉っぱってぱっと見すごい不規則な感じだけど
それでもよく見てみると規則性があるようにも感じる
面白い葉っぱだと思いました、まる

スイートバジル種まきから59日目
イメージ 49
イメージ 50
7/23に追肥したけどあんまり変化ないかな
でも背は伸びている


画像付き見出し付きテキストボックス作成のフローチャート書いてみた(1/3)

$
0
0
午後のパレットその43、午後のツールで画像付き見出し付きテキストボックスの見出しを画像に重ねる ( Windows ) - 午後わてんのブログ - Yahoo!ブログ

午後のツールのこのボタンのメモ
イメージ 1
画像付き見出し付きテキストボックスを作成するボタン

ボタン押した時の動き
イメージ 2
イメージ 3
選択セルの値を使って
見出しと本文と画像の3つの図形を作成して
グループ化



図形作成にセルの値を使うからセルを取得する必要がある
選択されているセルを取得するには
Selection.Areas
これで離れた場所の選択でも取得できる
AreasのなかのItem1、Item2…がそれぞれのセルの塊になる

Sub testAreas()
    Dim A As Areas
    Set A = Selection.Areas
    
    Dim A1 As Range, A2 As Range, A3 As Range
    Set A1 = A.Item(1)
    Set A2 = A.Item(2)
    Set A3 = A.Item(3)

    ’それぞれのセルアドレス
    Dim Ad1, Ad2, Ad3 As String
    Ad1 = A1.Address
    Ad2 = A2.Address
    Ad3 = A3.Address
    
End Sub

イメージ 5
それぞれのセルアドレスが取得できている、赤枠

フローチャート作ってみた
イメージ 4
開始がボタンのクリックイベントに関連付けになる

i = 1 To Areas.Count
これがエリアのループ、最初のエリアから最後のエリアまでループさせて
次の
j = 1 To Areas(i).Rows.Count
これで各エリアの中の行をループさせる
最後の行まで来たら次のエリアの最初の行からになる

実際に見出し付きテキストボックスを作成する部分の
sakusei図形作成のフローチャート
イメージ 7
紫の枠の処理はまた別の関数やメソッドになっている




イメージ 1
↑の画像付き見出し付きTBボタンのクリックイベントが↓
イメージ 6
メモがいっぱいあるけど

Private Sub CommandButton6_Click()
'画像付き見出し付きテキストボックス
    Call sakusei図形作成(PicAndTextBoxWihtMidasi, 1)
End Sub

これだけで
sakusei図形作成を呼び出しているだけ

引数の
PicAndTextBoxWihtMidasi
は作ったeTextBoxTypeという列挙型の値↓

'テキストボックスタイプ
Enum eTextBoxType
    MidasiOnly = 1              '見出しのみ
    TextBoxWithMidasi = 0       '見出し付きテキストボックス
    PicAndTextBoxWihtMidasi = 2 '画像付き見出し付きテキストボックス
End Enum

作成する図形の種類を判別するためのもの
PicAndTextBoxWihtMidasiは画像付き見出し付きテキストボックスになる

もう一つの引数1は作成する図形の種類ってさっきと同じだけど
こっちはエクセルに最初から用意されている図形で
1は四角形
2は平行四辺形とかになっている
ほかにもいっぱいある




全体で使う変数と列挙型(フォームのプロシージャの先頭に書く)
使っていないのもあるかも

Private myFillForeColor As FillForeColor
Public myFontColor As eFontColor
Public myTextFontColor As TextFontColor
'Private NuriColor As Long '塗りつぶしの色
'Private MoziColor As Long 'フォントカラー


'見出しの背景色用
Enum FillForeColor
    Unspecified = 0
    Sample = 1
    Random = 2
    CellLink = 3
End Enum

'見出しの文字色用
Enum eFontColor
    fcWhite = 0
    fcBlack = 1
    fcAuto = 2
    fcCell = 3
    fcRandom = 4
    fcWorB = 5
End Enum

'本文の文字色用
Enum TextFontColor
    tfcBlack = 0
    tfcAuto = 1
End Enum

'テキストボックスタイプ
Enum eTextBoxType
    MidasiOnly = 1              '見出しのみ
    TextBoxWithMidasi = 0       '見出し付きテキストボックス
    PicAndTextBoxWihtMidasi = 2 '画像付き見出し付きテキストボックス
End Enum
イメージ 8

また文字数制限に引っかかったので分割記事になってしまった
続きは
画像付き見出し付きテキストボックス作成のフローチャート書いてみた(2/3) ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ




画像付き見出し付きテキストボックス作成のフローチャート書いてみた(2/3)

$
0
0
続き
前の記事は
画像付き見出し付きテキストボックス作成のフローチャート書いてみた(1/2) ( ガーデニング ) - 午後わてんのブログ - Yahoo!ブログ

イメージ 6
フローチャートって初めて書いてみたけど時間かかる、2時間位かかった
参照したところは
この辺り


sakusei図形作成
Sub sakusei図形作成(sType As eTextBoxType, MidasiType As Long)
    Dim Mida As Shape '見出し図形
    Dim Hon As Shape '本文図形
    Dim fillC As Long '見出し背景色
    Dim fontC As Long '見出し文字の色
    Dim mASType As MsoAutoShapeType '図形の種類
    'テキストボックス(本文)
    Dim tbLineC As Long 'テキストボックス枠の色
    Dim tbFontC As Long 'テキストボックスフォントカラー
'    Dim tbFillC As Long 'テキストボックス背景色
    Dim TB As Shape 'テキストボックス
    Dim TBR As Range 'テキストボックス用セル
    Dim fitHeight As Boolean
    
    '画像図形
    Dim Pic As Shape '画像図形
    Dim PR As Range '画像ファイルのパスがあるセル
    Dim pName As String '画像ファイルのパス
    
    Dim GP As Shape
    Dim RS  As Range, R As Range
    Dim Area As Areas
    Dim ash As Worksheet
    Dim i As Long, j As Long
    Set ash = ActiveSheet
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Set Area = Selection.Areas
    'mASType = Me.CommandButton4.Tag ' msoShapeRectangle'ボタンのtagで作成する図形を指定する
    
    
    For i = 1 To Area.Count
        Set RS = Area(i)
        For j = 1 To RS.Rows.Count
            Set R = RS.Cells(j, 1)
            Set TBR = R.Offset(, 1)
            Set PR = R.Offset(, 2)
            '画像付きの時、画像ファイルの確認
            If sType = PicAndTextBoxWihtMidasi Then
                
                pName = PR.Value
                '画像ファイルパスが空欄ならファイル指定ダイアログ表示
                If pName = "" Then
                    pName = Application.GetOpenFilename(",*.jpg;*.jpeg;*.bmp;*.png;*.gif", , R.Value)
                End If
                If pName = "False" Then Exit Sub '画像指定でキャンセルされたら終了
                
                '画像ファイルの存在確認
                If Dir(pName) = "" Then
                    MsgBox "指定されたファイル 「" & pName & "」 は見つからなかったので処理を終了"
                    Exit Sub '存在しないファイル名なら終了
                ElseIf Judge画像ファイル拡張子で判定(pName) = False Then
                    MsgBox "指定されたファイル" & vbNewLine _
                        & pName & vbNewLine _
                        & "は開くことができなかったので処理を終了"
                    Exit Sub '拡張子が画像以外なら終了
                End If
            End If
            
            '背景色や文字色の取得
            fillC = GetFillColor背景色(R)
            fontC = GetFontColor見出しの文字の色(R, fillC)
            honFontC = GetFontColor本文の文字の色(fillC)
            tbLineC = fillC
            tbFontC = GetFontColor本文の文字の色(fillC)
            
            '見出しの図形作成
            'Set Mida = AddMida見出し作成(R, mASType, 160, fillC, fontC)
            Set Mida = AddMida見出し作成(R, MidasiType, 160, fillC, fontC)
            Mida.Placement = xlMove
                        
            If sType = TextBoxWithMidasi Then
            '見出し付きTB
                '本文用のテキストボックス作成
                Set TB = AddTextBox本文図形作成(TBR, 160, tbFontC, tbLineC)
                '見出しと本文の位置調整
                'Dim fitCell As Boolean: fitCell = Me.CheckBoxFitHeightToCell.Value
                fitHeight = Me.CheckBoxFitHeightToCell.Value
                Call ReadjustSub位置合わせ(Mida, TB, False, fitHeight)
                
                'グループ化
                Set GP = ash.Shapes.Range(Array(Mida.Name, TB.Name)).Group
                GP.Placement = xlMove 'セルに合わせて移動するけどサイズ変更はしない
            ElseIf sType = PicAndTextBoxWihtMidasi Then
            '画像付き見出し付きテキストボックス
                '本文用のテキストボックス作成
                Set TB = AddTextBox本文図形作成(TBR, 160, tbFontC, tbLineC)
                Set Pic = GetPictureFromFile(pName)
                Call Adjust見出しとテキストボックスと画像の位置調整(Mida, TB, Pic)
                'グループ化
                Set GP = ash.Shapes.Range(Array(Mida.Name, TB.Name, Pic.Name)).Group
                GP.Placement = xlMove
                
            End If
                    
        Next j
    Next i
        
End Sub
イメージ 1
これがさっきのフローチャートの画像作成の部分



その他の細かいメソッドや関数は
背景色や文字色の取得が
Function GetFillColor背景色(R As Range) As Long
'背景色を返す、使う引数はセル
    Dim myColor As Long
    Select Case True
        Case myFillForeColor = Sample '見本の色
           myColor = Me.LabelSampleColor色見本.BackColor
        Case myFillForeColor = Random 'ランダム
            Randomize
            myColor = Int((16777215 - 0 + 1) * Rnd(16777215) - 0)
        Case myFillForeColor = CellLink 'セルと同じ色
            myColor = R.Interior.Color
        Case myFillForeColor = Unspecified '指定なしは初期テーマカラー
            Dim ash As Workbook
            Set ash = ActiveWorkbook
            myColor = ash.Theme.ThemeColorScheme.Colors(msoThemeAccent1)
            
    End Select
    GetFillColor背景色 = myColor
    
End Function
イメージ 2

見出し部分の背景色の取得
フォームの
イメージ 3
赤枠部分のどこにチェックが入っているかで色を決めている





見出し部分のフォントの色取得
Function GetFontColor見出しの文字の色(R As Range, fillC As Long) As Long
    Dim myColor As Long
    Dim Y As Double
    Select Case True
        Case myFontColor = fcAuto 'オート、白or灰色
            Y = Color2HDTV(fillC)
            If Y < 230 Then
                myColor = RGB(255, 255, 255)
            Else
                myColor = RGB(192, 192, 192)
            End If
        Case myFontColor = fcBlack '黒
            myColor = RGB(0, 0, 0)
        Case myFontColor = fcCell 'セルと同じ色
            myColor = R.Font.Color
        Case myFontColor = fcRandom 'ランダム
            Randomize
            myColor = Int((16777215 - 0 + 1) * Rnd(16777215) - 0)
        Case myFontColor = fcWhite '白
            myColor = RGB(255, 255, 255)
        Case myFontColor = fcWorB '白or黒の自動判別
            Y = Color2HDTV(fillC)
            If Y < 230 Then
                myColor = RGB(255, 255, 255)
            Else
                myColor = RGB(0, 0, 0)
            End If
    End Select
    GetFontColor見出しの文字の色 = myColor
End Function
イメージ 4
これもフォームの
イメージ 5
赤枠部分のどこにチェックが入っているかで決定


本文の文字色取得
Function GetFontColor本文の文字の色(fillC As Long) As Long
    Dim myColor As Long
    Dim Y As Double
    Select Case True
        Case myTextFontColor = tfcAuto
            Y = (Color2HDTV(fillC) / 2)
            myColor = RGB(Y, Y, Y)
        Case myTextFontColor = tfcBlack
            myColor = RGB(0, 0, 0)
    End Select
    
    GetFontColor本文の文字の色 = myColor
End Function

またエラーになったので分割
続きは
画像付き見出し付きテキストボックス作成のフローチャート書いてみた(3/3) ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ










Yahoo!の人へのお願い
メール送っても無視されるからここに記録してみる
イメージ 7
確認ボタンではエラーにならないけど投稿ボタンを押すとエラー
しばらく(1時間経過)してから投稿してもエラー
記事の文字数を減らせば投稿できるけど
書きなおすのがめんどくさい
コピペすると画像と水平線が消えるので文字以外は全部やり直し
めんどくさい!

イメージ 8
だいたい文字数だって2万文字までOKって言っているのに
1万文字でえらーになるのがおかしい
直せないとか直す気がないならそう言って欲しい…






















画像付き見出し付きテキストボックス作成のフローチャート書いてみた(3/3)

$
0
0
画像付き見出し付きテキストボックス作成のフローチャート書いてみた(2/3) ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
↑の記事の続き
多分最後のページ、3分割とか初めてだわ


見出し部分の図形作成

Rセル(range)
mASType図形の種類 (MsoAutoShapeType)
Wid図形の幅
fillC背景色
fontC文字色

Function AddMida見出し作成(R As Range, mASType As MsoAutoShapeType, Wid As Single, fillC As Long, fontC As Long) As Shape
    Dim Mida As Shape
    Dim i As Long
    Dim ash As Worksheet
    Set ash = ActiveSheet
    Dim textCount As Long
    'Set Mida = ash.Shapes.AddShape(msoShapeRectangle, R.Left, R.Top, Wid, R.Height)
    Set Mida = ash.Shapes.AddShape(mASType, R.Left, R.Top, Wid, R.Height)
    With Mida.TextFrame
        .HorizontalAlignment = xlHAlignCenter   '水平位置中央
        .VerticalAlignment = xlVAlignCenter     '垂直位置中央
        .Characters.Text = R.Value          '文字入れ
        textCount = .Characters.Count           '文字数カウント
'                .MarginBottom = tCell.Font.Size / 4
'                .MarginTop = tCell.Font.Size / 4
    End With
    
    With Mida
        .Line.Weight = 0.1
        .Line.ForeColor.RGB = fillC
        .Fill.ForeColor.RGB = fillC '塗りつぶしの色
        If Me.CheckBoxFillColorNothing.Value Then
            .Fill.Transparency = 1 '背景色なしは完全透明
        End If
    End With
    
    With Mida.TextFrame2.TextRange.Characters(1, textCount).Font
        .Name = R.Font.Name         'フォント指定
        .NameFarEast = R.Font.Name  '日本語のフォント指定
        'フォントサイズ
        If Me.CheckBoxCaptionMagnification倍率.Value Then
            .Size = R.Font.Size * 1.2
        Else
            .Size = R.Font.Size
        End If
        .Bold = msoTrue             '太字指定
        .Fill.ForeColor.RGB = fontC '文字色
    End With
    
    'テキストボックスの縦幅をテキストに合わせる
    Mida.TextFrame2.AutoSize = msoAutoSizeShapeToFitText 'TextFrameのAutoSizeとは少し違い
    '横幅は変化しないで高さだけが調整される+少し高さが高くなる
    
    '再度位置調整
    Mida.Top = R.Top
    
    Set AddMida見出し作成 = Mida
    
End Function
イメージ 1





本文の図形作成
Rセル Range
Wid図形の幅 As Single
fontC文字色 As Long
lineC枠の色 As Long

Function AddTextBox本文図形作成(R As Range, Wid As Single, _
            fontC As Long, lineC As Long) As Shape
    Dim TB As Shape 'テキストボックス
    Dim ash As Worksheet
    Set ash = ActiveSheet
    Dim textCount  As Long
    Set TB = ash.Shapes.AddTextbox(msoTextOrientationHorizontal, R.Left, R.Top, Wid, R.Height)
        
    '枠の色
    With TB.Line
        .Weight = 0.1
        .ForeColor.RGB = lineC
    End With
    
    '背景色
    With TB.Fill
        If Me.CheckBoxFillColorNothing.Value Then
            .Transparency = 1           '完全透明
        End If
    End With
    
    'テキストフレーム1
    With TB.TextFrame
        .Characters.Text = R.Value              'テキスト指定
        If Me.CheckBoxTextAlignCenter.Value Then
            .HorizontalAlignment = xlHAlignCenter '中央揃え
        End If
        textCount = .Characters.Count           '文字数カウント
    End With
    
    'テキストフレーム2
    With TB.TextFrame2.TextRange.Characters(1, textCount).Font
        .Name = R.Font.Name         'フォント指定
        .NameFarEast = R.Font.Name  '日本語のフォント指定
        .Size = R.Font.Size         'フォントサイズ
        .Fill.ForeColor.RGB = fontC 'フォントカラー
    End With
    
    'セルの値をテキストボックスにリンク表示
    If Me.CheckBoxTextLinkToCell.Value Then
        TB.DrawingObject.Formula = R.Address
    End If
    
    '横幅そのままで高さだけをテキストに合わせる
    TB.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    
    Set AddTextBox本文図形作成 = TB
    
End Function
イメージ 2





見出しとテキストボックスの位置調整
myShape As Shape見出し用図形
myTB As Shapeテキストボックス
fitCell As Boolean位置をセルグリッドに合わせる
fitHeight As Booleanテキストボックスの下のラインをセルグリッドに合わせる

Public Sub ReadjustSub位置合わせ(myShape As Shape, myTB As Shape, _
                                Optional fitCell As Boolean = False, _
                                Optional fitHeight As Boolean = False)
    Dim myTop As Single
    '見出し用の図形をセルに合わせてから本文のテキストボックスを見出しにあわせる
    If fitCell Then
        Call FitShapes2Cell図形位置を最寄りのセルにピッタリ(myShape)
    End If
    
    myTop = myShape.Top
    myShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    myShape.Top = myTop
    With myTB
        .Width = myShape.Width
        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame2.VerticalAnchor = msoAnchorTop
        .Top = myShape.Top + myShape.Height
        .Left = myShape.Left
        
        'テキストボックスの高さの再調整してセルに合わせる
        If fitHeight Then
            Dim cellH As Single, TBH As Single
            cellH = .BottomRightCell.Top + .BottomRightCell.Height
            TBH = .Top + .Height
            .TextFrame2.VerticalAnchor = msoAnchorMiddle '縦位置中央
            .Height = .Height + (cellH - TBH)
        End If
    End With
End Sub
イメージ 3




画像付き見出し付きテキストボックスの位置調整
Mida As Shape見出し用図形
TB As Shapeテキストボックス
Pic As Shape画像図形

Sub Adjust見出しとテキストボックスと画像の位置調整(Mida As Shape, TB As Shape, Pic As Shape)
'渡されたテキストボックスと見出しと画像の位置を再調整
   
    With Mida
        .Width = Pic.Width
        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
        Pic.Left = .Left
        If .Fill.Transparency = 0 Then
        '見出しの背景色が完全不透明なら
            Pic.Top = .Top + .Height
        Else
            Pic.Top = .Top
        End If
    End With
    
    With Pic
        TB.Width = .Width
        TB.Top = .Top + .Height
        TB.Left = .Left
        TB.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    End With
    
End Sub
イメージ 4



背景色の輝度の取得

RGB各色の値の入れ物myRGB

Public Type myRGB
    iRed As Integer
    iGreen As Integer
    iBlue As Integer
End Type




セルの背景色Range.Interior.Colorとかの値を渡して輝度を取得する
Color2HDTV

Function Color2HDTV(myColor As Long)
    Dim rr As Double, gg As Double, bb As Double, X As Double
    Dim R As Double, G As Double, B As Double
    Dim iRGB As myRGB
    iRGB = Color2RGB(myColor)
    R = iRGB.iRed
    G = iRGB.iGreen
    B = iRGB.iBlue
    
    rr = 0.222015
    gg = 0.706655
    bb = 0.07133
    X = 2.2
    
    R = (R ^ X) * rr
    G = (G ^ X) * gg
    B = (B ^ X) * bb
    Dim Y
    Y = (R + G + B) ^ (1 / X)
    Color2HDTV = Y
End Function




セルの背景色Range.Interior.Colorとかの値を渡してRGB各色を取得する
Color2RGB

Function Color2RGB(ByVal myColor As Long) As myRGB
'Color(Long)をRGBにして返す
    Dim iRGB As myRGB
    With iRGB
        .iRed = myColor Mod 256
        .iGreen = Int(myColor / 256) Mod 256
        .iBlue = Int(myColor / 256 / 256)
    End With
    Color2RGB = iRGB
End Function


ただでさえわかりにくい記事が3分割でもっとわかりにくくなってしまった
フローチャートはどこまで細かく書けばいいのかがわかんないなあ
あんまり細かく書くとプロシージャと差がないようなものができあがりそうだし
書いてる時は楽しいけど時間もかかる
今回のはかなり大雑把に書いたけど2時間位かかった
全体の処理の流れを見るのにはいいかもしれないけどどうなのかなあ
半年後とか忘れたころに見ればまた違うのかも

選択されている図形の種類を判定して図形のサイズと位置を再調整するボタンの中身のメモ

$
0
0

イメージ 1
エクセルアドインの午後のパレットの午後の
見出し付きテキストボックスは複数の図形をグループ化しているだけ


レイアウトの崩れてしまったのを右の状態にするボタン
イメージ 7
再調整画像付きTB
選択された図形を再調整する
これの動きのメモ

サイズの調整をしてから位置の調整をしている
サイズ調整は
見出しと本文の図形の幅を画像に合わせる
高さは文字に合わせる

位置の調整は
基準が見出し図形にして
画像図形を見出しの下側
本文を画像図形の下側

これには選択された図形が何の図形なのかを取得する必要がある
見出し図形なのか、本文用のテキストボックスなのかとか
これが難しかったのでメモしておこうかと
もっといい方法がありそうだけど思いつかない



グループ化された図形の選択状態は2種類ある
AとBと区別すると
イメージ 2
これはグループ化図形をそのまま選択した状態で
名前のところが「グループ化 339」になっている
これがA

イメージ 3
これはグループ化図形の中の見出し部分の図形を選択した状態
名前のところが「正方形/長方形 340」になっている
これがB

イメージ 4
グループ化図形の中の画像図形を選択した状態
名前のところが「図 342」になっている
これもB

グループ化図形そのもの全体を選択している状態Aと
グループ化図形の中の1つの図形を選択しているBの違い
B状態は特殊で1つのグループ化図形を選択している時だけで
複数のグループ化図形を選択している状態では発生しない

イメージ 5
こういう状況はありえない
複数図形を選択しているのにグループ化図形の中の1つの図形を選択した状態
左がB状態で右がA状態って言うことになはらない

イメージ 6
必ずこうなる
A状態の選択が2つになる


図形のいろいろな選択状態(Selection.ShapeRangeの中)を見てみる
イメージ 9

Sub testShape()
    Dim SR As ShapeRange
    Set SR = Selection.ShapeRange
    
End Sub

図形を選択した状態で↑を実行して一時停止して
SRの中身を見てみる

ローカルウィンドウの表示方法
イメージ 29
メニューの表示からローカル ウィンドウで表示される


イメージ 8
一個の四角形図形を選択した状態
イメージ 10
グループ化図形ではないのでグループ化に関係するところの値は
GroupItemsがこのメンバにアクセスできるの~
ParentGroupが指定された値は境界を超えて~
とかまともな値が入っていないのがわかる
TypeがmsoAutoShape


グループ化図形を選択した状態
イメージ 11
イメージ 12
GroupItemsは+が付いているのでなにか値が入っている
ParentGroupはさっきと同じでエラーみたいになっている
TypeはmsoGroupになっている、この図形はグループ化図形ですってことかな
GroupItemsの中身を見てみる
イメージ 13
Item1から3があってそれがが個別の図形を表しているみたい
Item1の中身を見てみる
イメージ 14
Item1の型はVariant/Object/Shapeって表示されているから
図形
3つは見出しと本文と画像の3つの図形ってことみたい


グループ化図形の中の本文用図形のテキストボックスを選択した状態
イメージ 15
イメージ 16
GroupItemsはエラーみたいになっている
TypeはTextBoxになっている
ParentGroupはなにか値が入っているので中身を見てみる
イメージ 17
Typeの値がmsoGroupだからグループ化図形
Nameもグループ化 339ってなっている

ここまでまとめると
イメージ 20
簡単に見分けることができるのはグループ化図形そのままの時で
これはType=msoGroupで判定できる
問題は単独図形なのかグループ化図形の中の1つなのかの判断
ParentGroupになにか値が入っているなら
グループ化図形の中の1つってことになるけど
この判定の仕方がわからない
例えば
Sub testShape()
    Dim SR As ShapeRange
    Set SR = Selection.ShapeRange
        
    If IsError(SR.ParentGroup) Then’エラーの判定
        '処理
    End If
    
    If SR.ParentGroup Is Nothing Then ’空っぽの判定
        '処理
    End If    
End Sub
エラーの判定と空っぽの判定どちらもエラーになる
指定された値は境界を超えていますはエラーでも空っぽでもないってことみたい
そうなんだろうけど、でもどうやって判定すればいいかわからないので
エラーになるならエラーになったら単独図形で
エラーにならなかったらグループ化図形の中の1つ
って判定することにした




複数の図形が選択されている場合
イメージ 18
イメージ 19
GroupItems、ParentGroupともに値なし
TypeはmsoShapeTypeMixedってのになっているなあ、これは気にしてない
複数の図形が選択されている場合の特徴は
Countが2以上の数値になっているのと
その数値分のItemがあること
なのでSelection.ShapeRange.Countが2以上なら
複数の図形が選択されているって判定できる

あとはそれぞれの図形の種類の判定
単独図形なら見出しの図形ってことになるからそれ以外の
見出し付きテキストボックスと画像付き見出し付きテキストボックス
この2つの中の図形をそれぞれ判定することになる
イメージ 21
2つのグループ化図形を選択した状態これをそれぞれ取得して
中を見てみる
Sub testShape()
    Dim SR As ShapeRange
    Set SR = Selection.ShapeRange
    Dim GP1 As GroupShapes, GP2 As GroupShapes
    Set GP1 = SR.Item(1).GroupItems
    Set GP2 = SR.Item(2).GroupItems
End Sub
イメージ 22
GroupShapesっていうクラス?型?を使って
ShapeRange.Item(n).GroupItemsでそれぞれのグループ化図形を取得している
少し広げてみると
イメージ 23
1個目のGroupItemsの中にはItemが2つ
2個めのGroupItemsの中にはItemが3つ
あるのがわかる
イメージ 24
GP1のItem1のTypeはmsoAutoShape

イメージ 25
Item2のTypeはmsoTextBox

これで何の図形かわかるけど
実際にGP1.Item(1).Typeの値を取得するとmsoAutoShapeじゃなくて
数値の1になってる、これだとわかりにくいので
イメージ 26
DrawingObjectっていうのを使ってこれをTypeNameにまかせてみたら
わかりやすくRectangleっていう文字列が返ってきた
テキストボックスも17っていう数字じゃなくて文字列のTextBox
このDrawingObjectってのが便利だけどよくわからなくて
イメージ 27
候補一覧には出てこない、なんで?

イメージ 28
画像図形はPictureで返ってくる、わかりやすい

これで図形の取得や判別はできたので後は順番にサイズと位置を変更するだけ

デザイン画面
イメージ 30
再調整画像付きTBボタンの名前はCommandButton7
名前をつけるのがめんどくさくなってそのままの名前になっている
このボタンのクリックイベントに

Private Sub CommandButton7_Click()
    Call ReAjustAllShape選択図形すべての位置とサイズを再調整    
End Sub
イメージ 31


'ボタンのクリックイベントにくっつける
Sub ReAjustAllShape選択図形すべての位置とサイズを再調整()
'選択された図形を取得、グループ化された図形の場合は分解して配列に入れた状態で取得
'配列の順番は0=見出し、1=本文(テキストボックス)、2=画像
    On Error Resume Next
    
    Dim SR As ShapeRange
    Dim SS() As Shape
    Set SR = Selection.ShapeRange
    
    If SR.Count = 1 Then
    '選択図形が一個の場合(完全単独か1つのグループ化の中の一つの図形を選択した状態)
        SS = GetShapes特殊選択状態(SR.Item(1))
        '処理
        Call ReAjust図形タイプごとに位置とサイズを再調整(SS)
        
        
    Else
    '複数図形が選択されている場合
        Dim i As Long
        For i = 1 To SR.Count
            
            If SR.Item(i).Type = msoGroup Then
            'グループ化された図形の場合
                SS = GetShapesグループ化図形の中の図形を配列で取得(SR.Item(i).GroupItems)
            Else
            '単独図形の場合
                ReDim SS(0)
                Set SS(0) = SR.Item(i)
            End If
            
            '処理
            Call ReAjust図形タイプごとに位置とサイズを再調整(SS)
            
        Next
    End If
End Sub
イメージ 32
フォームモジュールに書いても同じだけど
このへんから標準モジュールに書いているんだなあ
書いてあるのは選択された画像を順番に取得して
図形のサイズと位置を再調整するプロシージャに投げている( ´∀`)つ ミ


Function GetShapes特殊選択状態(CS As Shape) As Shape()
    Dim SS() As Shape
    Dim GP As GroupShapes
    '渡されたshapeがグループ化図形か単独図形なのかを判断するのに
    'エラーを使っている
    'GroupShapesの変数に入れようとしてエラーになれば単独図形と判断して
    'エラーが起きたらmyErrに飛ぶ
        
    If CS.Type <> msoGroup Then
        On Error GoTo myErr
    'ParentGroupがあるグループ化の中のどれか1つの図形選択状態
        Set GP = CS.ParentGroup.GroupItems
    ElseIf CS.Type = msoGroup Then
    '1つのグループ化された図形選択状態
        Set GP = CS.GroupItems
    Else
    
myErr:
    'ParentGroupがない単独図形
        ReDim SS(0)
        Set SS(0) = CS
    End If
        
        
    If Not GP Is Nothing Then
    'グループ化された図形の場合、順番を揃えて配列に入れる
        SS = GetShapesグループ化図形の中の図形を配列で取得(GP)
    End If
    
            
    Err.Clear
    GetShapes特殊選択状態 = SS
    
End Function
イメージ 33
これは選択された図形がグループ化図形なのか
グループ化図形の中の1つの図形なのか
単独図形なのかの判定
方法を思いつかないのでエラーで判定しているところ


Function GetShapes特殊選択状態(CS As Shape) As Shape()
    Dim SS() As Shape
    Dim GP As GroupShapes
    '渡されたshapeがグループ化図形か単独図形なのかを判断するのに
    'エラーを使っている
    'GroupShapesの変数に入れようとしてエラーになれば単独図形と判断して
    'エラーが起きたらmyErrに飛ぶ
        
    If CS.Type <> msoGroup Then
        On Error GoTo myErr
    'ParentGroupがあるグループ化の中のどれか1つの図形選択状態
        Set GP = CS.ParentGroup.GroupItems
    ElseIf CS.Type = msoGroup Then
    '1つのグループ化された図形選択状態
        Set GP = CS.GroupItems
    Else
    
myErr:
    'ParentGroupがない単独図形
        ReDim SS(0)
        Set SS(0) = CS
    End If
        
        
    If Not GP Is Nothing Then
    'グループ化された図形の場合、順番を揃えて配列に入れる
        SS = GetShapesグループ化図形の中の図形を配列で取得(GP)
    End If
    
            
    Err.Clear
    GetShapes特殊選択状態 = SS
    
End Function
イメージ 34
グループ化図形のGroupShapesを送って中の図形を種類判定して
0=見出し、1=本文、2=画像の順番に配列に入れて返している


Sub ReAjust図形タイプごとに位置とサイズを再調整(SS() As Shape, Optional FitTBHeight As Boolean = False)
'FitTBHeight=Trueでテキストボックスの高さをセルのグリッドに合わせる
'Midaが見出しの図形、TBがテキストボックス,Picが画像図形
'それぞれの図形のの位置とサイズを再調整
    Dim Mida As Shape, TB As Shape, Pic As Shape
        
    Select Case UBound(SS)
        Case 0
        '見出しだけの時
            Set Mida = SS(0)
            '処理、特にやること無い?
        Case 1
        '見出しとテキストボックスのとき
            Set Mida = SS(0)
            Set TB = SS(1)
            Call ReadjustSub位置合わせ(SS(0), SS(1))
            If FitTBHeight Then
                Call FitHeightToCell図形の高さをセルグリッドに合わせる(SS(1))
            End If
        Case 2
        '見出しとテキストボックスと画像のとき
            Set Mida = SS(0)
            Set TB = SS(1)
            Set Pic = SS(2)
            Call Adjust見出しとテキストボックスと画像の位置調整(SS(0), SS(1), SS(2))
            
            If FitTBHeight Then
                Call FitHeightToCell図形の高さをセルグリッドに合わせる(SS(1))
            End If
    End Select
    
End Sub
イメージ 35
さっき並べ直した図形の配列を受けて、図形のサイズと位置を再調整する
プロシージャに投げている
図形の数が1なら見出しだけ、2こなら見出し付きテキストボックス
3個なら画像付き見出し付きテキストボックス
って判定している




Public Sub ReadjustSub位置合わせ(myShape As Shape, myTB As Shape, _
                                Optional fitCell As Boolean = False, _
                                Optional fitHeight As Boolean = False)
    Dim myTop As Single
    '見出し用の図形をセルに合わせてから本文のテキストボックスを見出しにあわせる
    If fitCell Then
        Call FitShapes2Cell図形位置を最寄りのセルにピッタリ(myShape)
    End If
    
    myTop = myShape.Top
    myShape.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    myShape.Top = myTop
    With myTB
        .Width = myShape.Width
        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
        .TextFrame2.VerticalAnchor = msoAnchorTop
        .Top = myShape.Top + myShape.Height
        .Left = myShape.Left
        
        'テキストボックスの高さの再調整してセルに合わせる
        If fitHeight Then
            Dim cellH As Single, TBH As Single
            cellH = .BottomRightCell.Top + .BottomRightCell.Height
            TBH = .Top + .Height
            .TextFrame2.VerticalAnchor = msoAnchorMiddle '縦位置中央
            .Height = .Height + (cellH - TBH)
        End If
    End With
End Sub
イメージ 36
見出し付きテキストボックスのサイズと位置を再調整


Sub Adjust見出しとテキストボックスと画像の位置調整(Mida As Shape, TB As Shape, Pic As Shape)
'渡されたテキストボックスと見出しと画像の位置を再調整
   
    With Mida
        .Width = Pic.Width
        .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
        Pic.Left = .Left
        If .Fill.Transparency = 0 Then
        '見出しの背景色が完全不透明なら
            Pic.Top = .Top + .Height
        Else
            Pic.Top = .Top
        End If
    End With
    
    With Pic
        TB.Width = .Width
        TB.Top = .Top + .Height
        TB.Left = .Left
        TB.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    End With
    
End Sub
イメージ 37
画像付き見出し付きテキストボックスのサイズと位置を再調整



Sub FitHeightToCell図形の高さをセルグリッドに合わせる(S As Shape)
'渡された図形の高さをセルグリッドに合わせる
'テキストの縦の表示位置は中央に変更
    Dim cellH As Single
    Dim SH As Single
    With S
        cellH = .BottomRightCell.Top + .BottomRightCell.Height
        SH = .Top + .Height
        .TextFrame2.VerticalAnchor = msoAnchorMiddle 'テキストの縦位置中央
        .Height = .Height + (cellH - SH)
        
    End With
   
End Sub
イメージ 38
テキストボックスの下の枠をセルグリッドに合わせる

これでサイズと位置を再調整ボタンに関係するのは全部かな
やっぱりフローチャートあったほうがわかりやすいかなあ
今回の記事も文字が多いので全部書いてから投稿ボタンを押してエラーになって
書き直しが怖くて少し書いては投稿→記事の修正→少し書いては投稿をして書いた
これを繰り返している間は公開範囲設定を公開しないにして
書き終わったら全公開にして投稿
これなら変なエラーで記事を作りなおすことは避けられるけどめんどくさいw
ここまでで文字数は9500文字くらい
昨日はこれくらいでも投稿エラーになった


Viewing all 420 articles
Browse latest View live