面白そうなこと探しています・・・・・・・・・・台湾ラーメンブログ

Excelでドット絵を作成するマクロを作ってみた

FB友達の○○○さんが、ドットでスーパーマリオの絵を描いていたので

 

自分もドット絵を簡単に描けるプログラムをマクロで組んでみた

中身は、カラーバーをクリックすることにより色選択をして

セルをクリックすると、セルの色が選択した色に変わるもの

 

色を塗るプログラムはこちら

========================================================

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r, c As Integer
Dim myColor, palletR, palletG, palletB As Long

r = ActiveCell.Row      'アクティブセルの行を取得
c = ActiveCell.Column   'アクティブセルの列を取得

Cells(9, 35) = r  'アクティブセルの行を(9,35)のセルに代入
Cells(9, 39) = c  'アクティブセルの列を(9,39)のセルに代入

'パレットの中から色を決める
If c = 31 Then              '選んだセルがパレットの範囲内かIF構文で確認(パレットは(10〜23,31))
    If r > 10 Then
        If r < 24 Then
       
            myColor = ActiveCell.Interior.Color  'パレットの色番号を取得
   
            palletR = myColor Mod 256               '色のR成分を取得
            palletG = Int(myColor / 256) Mod 256    '色のG成分を取得
            palletB = Int(myColor / 256 / 256)      '色のB成分を取得
           
            Cells(10, 35).Value = palletR           'セル(10,35)にR成分を代入
            Cells(10, 39).Value = palletG           'セル(10,39)にG成分を代入
            Cells(10, 43).Value = palletB           'セル(10,43)にB成分を代入
           
        End If
    End If
   
End If

'選んだセルを決めた色に塗りつぶす
If c > 1 Then               '選んだセルがドット絵の範囲内かIF構文で確認(枠は(2〜26,2〜26))
    If c < 27 Then
        If r > 1 Then
            If r < 27 Then
                If Selection.Rows.Count > 1 Then
                    Exit Sub
                End If
                If Selection.Columns.Count > 1 Then
                    Exit Sub
                End If
            Cells(r, c).Interior.Color = RGB(Cells(10, 35).Value, Cells(10, 39).Value, Cells(10, 43).Value)
            '選んだセルを選んだ色に塗りつぶす
            End If
        End If
    End If
End If

End Sub

 

========================================================

複数セルの色変更はこちら(標準モジュール)

===============================

Sub ボタン5_Click()
Dim r, c As Integer
Dim numr, numc As Variant

r = ActiveCell.Row
c = ActiveCell.Column

If c > 1 Then               '選んだセルがドット絵の範囲内かIF構文で確認(枠は(2〜26,2〜26))
    If c < 27 Then
        If r > 1 Then
            If r < 27 Then
                Select_Range = ActiveWindow.RangeSelection.Address
                numr = Selection.Rows.Count
                numc = Selection.Columns.Count
                Range(Selection(1), Selection(Selection.Count)).Interior.Color = RGB(Cells(10, 35).Value, Cells(10, 39).Value, Cells(10, 43).Value)
            '選んだセルを選んだ色に塗りつぶす
            End If
        End If
    End If
End If

 

 

 

End Sub

==============================

 

色の消去

==============================

Sub ボタン4_Click()
'
' ボタン4_Click Macro
' マクロ記録日 : 2012/12/8  ユーザー名 : taka
'

'
   
Dim r, c  As Integer
r = ActiveCell.Row
c = ActiveCell.Column

    Range("B2:Z26").Select
    Selection.Interior.Color = RGB(255, 255, 255)
    Cells(r, c).Select
    ActiveCell.Interior.Color = RGB(255, 255, 255)
End Sub

=============================

 

割と簡単に作れて、子供たちも喜んで遊んでた♪
小3の娘の作品はこちら

 

 

yahooブログとfacebookの連携

facebookとyahooブログの連携を考えていたら

 

RSSを利用してお知らせする方法があるみたいなので

 

とりあえずやってみました。

 

これで様子を見よう・・・

 

http://www.facebook.com/yahooblogjp?ref=ts#!/note.php?note_id=197836456913069

 

(facebookのアカウントが必要です)

ブログと他のサービスの連携

yahooブログ、mixi、twitter、facebook、アメブロ・・・

 

いろんなインターネットサービスに参加した結果

 

更新するのが面倒になってきたので

 

連携することにした

 

twitterからfacebook、mixiへの連携は

 

簡単だけど

 

twitterからyahooブログへは難しそう・・・

 

しばらく試行錯誤かな？？？

 

 

ダイエット記事でアクセス急増・・・その原因は？

最近、ダイエット関係のブロガーの

 

アクセスが増えている・・・と思っていたら

 

どうやら、そうとはいえないらしい。

 

アクセスログを確認する

 

①ユーザ名はばらばら

 

②昨日や今日出来たばかりのブログが多い

 

③ダイエットやっていることより、ダイエット方法紹介記事が多い

 

と、いうことから

 

大半は、自動巡回ボットの

 

トレースらしい

 

ちょっと、がっかりした・・・

 

一日100アクセス以上あっても、大半がボットじゃあ

 

意味がない・・・

 

 

Googleで検索できるようになりました＾＾

ブログを書き始めて、3か月

 

ようやく、Googleで検索すると

 

トップにヒットするようになりました。

 

その検索キーワードは

 

台湾ラーメン　面白動画　です

 

yahooでは

 

まだまだ、トップには来ません

 

ヒットするようになるのはいつかな？？？

 

 

http://www.google.co.jp/images/srpr/nav_logo13.png

台湾ラーメン　面白動画

検索オプション

約 52,700 件 （0.10 秒） 

検索結果

1. 面白動画を集めてみました・・・・・台湾ラーメンブログ

   2010年5月23日 ... 台湾ラーメンのブログ、面白動画を集めてみました・・・・・台湾ラーメンブログです。 最近丸くなったと云われたのでパンチパーマにしてみました似合ってますか？
   ameblo.jp/nagoya-7-5-8-nagoya/ - キャッシュ

2. おしらせ｜面白動画を集めてみました・・・・・台湾ラーメンブログ

   2010年4月29日 ... 台湾ラーメンの面白動画を集めてみました・・・・・台湾ラーメンブログの記事、 おしらせです。
   ameblo.jp/nagoya-7-5-8-nagoya/entry-10520739181.html - キャッシュ
   ameblo.jp からの検索結果 »

3. 赤坂ラーメンIN台湾 ｜ 無料動画・おもしろ動画のムービーポータル ...

   投稿動画が盛り沢山！みんなで作るネットTV『AmebaVision（アメーバビジョン）』 サイバーエージェントが運営する日本最大級の投稿動画サイトAmebaVision[アメーバビジョン]は無料で利用が可能！毎日最新の投稿動画が見られます。
   vision.ameba.jp/watch.do;jsessionid...?movie=58586...1 - キャッシュ