How to Automatically Input RGB Information in Word VBA

このQ&Aのポイント
  • Learn how to automatically input RGB information in Word VBA using a software that displays the color information at the mouse position.
  • Currently, the RGB information is manually inputted using an input box, but you can make use of the information already copied to the clipboard.
  • By incorporating the clipboard content into the VBA macro, you can automatically set the RGB values and update the selected shape's fill color.
回答を見る
  • ベストアンサー

WORD VBA

マウスがある位置の色の情報を表示するソフトを利用して、 RGB情報を得ています。(例 RGB(204, 035, 035) 。 次のWORDマクロ動かし、RGB情報を手入力して欲しい結果を得ています。しかし、せっかくクリップボードに”RGB(204, 035, 035)”が入っていますので、それを自動的に以下のマクロに取り入れたいと考えております。どのようにすれば良いかアドバイスお願いできないでしょうか? なお, OSはWindows7を使用しています。Wordは2007です。 Sub ColorPaste() ' Dim Red As Integer Dim Green As Integer Dim Blue As Integer Red = InputBox("赤の数字を入れてください。") Green = InputBox("緑の数字を入れてください。") Blue = InputBox("青の数字を入れてください。") Selection.InlineShapes(1).Fill.BackColor = RGB(Red, Green, Blue) End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.3

すいません、ざっくりとですが。 Dim CB As New DataObject, buf As String, Arr As Variant Dim R As Integer, G As Integer, B As Integer   CB.GetFromClipboard   buf = CB.GetText   buf = Mid(buf, 5, Len(buf) - 5)   Arr = Split(buf, ",")     R = Arr(0)     G = Arr(1)     B = Arr(2)   Selection.InlineShapes(1).Fill.BackColor = RGB(R, G, B)   'または図形を選択して   Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End Sub 先にMidを使って、クリップボードの内容から必要な部分だけ引き出しておきます。   Rgb(255,99,100) → 255,99,100 それをSplitを使って","で区切り、配列に格納、それぞれをR,G,Bに割り当てます。   R=255  G=99  B=100 多分、大丈夫だと思うのですが・・・

oldhidesan
質問者

お礼

tsubuyukiさん ありがとうございました。私が希望する結果になりました。お世話になりました。

その他の回答 (2)

  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.2

> Sample2で試したところ、CB As New DataObjectのところで、「ユーザー定義型は定義されていません。」と表示 これが回答中の >> Microsoft Forms 2.0 Object Libraryを参照設定しておかないと >> DataObjectを定義するところでエラーで止まります。 >> ツール→参照設定で見当たらない場合は、空のユーザーフォームを作るフリをすると出てきます。 の部分に当たります。 ・・・と言うかすいません^^; 画像を添付したらよかったですね^^; VBE(マクロを書くウィンドウ)のメニュー、 ツール→参照設定 を選択すると、図のようなダイアログが出てきますので、 「Microsoft Forms 2.0 Object Library」を探してチェックを入れてやってください。 これで見当たらない時はVBEのメニュー、挿入→ユーザーフォーム を選択し、 空のユーザーフォームを作り、そのあとで参照設定をもう一度してみてください。 今度は上の方にチェックが入った状態で出てくると思います。 その後、先般のマクロを走らせると、今度は動くようになっている・・はずです^^;

oldhidesan
質問者

お礼

tsubuyukiさん ありがとうございます。ご返事を見る前に補足として書き込みさせてもらいました。定義の件は解決したのですが、新しい質問を補足でさせてもらいました。 よろしくお願いします。

  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.1

その > マウスがある位置の色の情報を表示するソフト がどんなソフトで、クリップボードにどのように格納されているかハッキリしませんが・・ とりあえず、 Sub Sample() Dim CB As New DataObject,buf As String      CB.GetFromClipboard  'CBにクリップボードをDataObjectとして取得   buf = CB.GetText    '変数bufにクリップボードのデータの文字を取得   MsgBox buf       '取得した文字をメッセージボックスに表示 End Sub こんな感じでクリップボードから取り出せます。 この場合、クリップボードの中身が「文字(または準ずるもの)」じゃないとエラーが返ります。 ちなみに、Microsoft Forms 2.0 Object Libraryを参照設定しておかないと DataObjectを定義するところでエラーで止まります。 ツール→参照設定で見当たらない場合は、空のユーザーフォームを作るフリをすると出てきます。 おっしゃる通り、 > クリップボードに”RGB(204, 035, 035)”が入って いるのであれば、 Sub Sample2() Dim CB As New DataObject, buf As String Dim R As Integer, G As Integer, B As Integer   CB.GetFromClipboard   buf = CB.GetText     R = Mid(buf, 5, 3)     G = Mid(buf, 10, 3)     B = Mid(buf, 15, 3)   Selection.InlineShapes(1).Fill.BackColor = RGB(R, G, B)   'または図形を選択して   'Selection.ShapeRange.Fill.ForeColor.RGB = RGB(R, G, B) End Sub で、出来る・・と思うのですが^^; 2007は手元に無いので確認とれずです、すいません^^;;

oldhidesan
質問者

お礼

tsubuyukiさん、早速ありがとうございます。 RGB(204,035,035)とクリップボードに入っていますので、Sample2で試したところ、CB As New DataObjectのところで、「ユーザー定義型は定義されていません。」と表示されてエラーになってしまいました。VBAが初心者で良く理解できておりません。よろしくご指導お願いします。 なお、RGB表示にスペースがありませんでしたので、G = Mid(buf, 9, 3) B = Mid(buf, 13, 3) に書き直ししました。

oldhidesan
質問者

補足

tsubuyukiさんが説明されていたのに、私が見過ごしました。定義の問題は解決しました。 ところが私の間違いで、RGBが全て3桁でないことが分かりました。1桁もあれば、2桁もあります。この場合には当然エラーになってしまいます。何か解決方法はないでしょうか? Sample1も問題なクリップボードの内容が表示されますが、 Selection.InlineShapes(1).Fill.BackColor = buf として受け渡すと「型が違う」となってしまいます。どのような型にすればよいのでしょうか? お手数をおかけしますが、よろしくお願いします。

関連するQ&A

  • VB.netでRGB関数を使うには

    こんにちは。 表題の通り、VB.netでRGB関数を使って背景色を変えたいんですが、以下のように入力してもエラーになってしまいます。VB6.0ではこれで通用すると書いてあり大丈夫だと思ったんですが、どこをどう直せばいいんでしょうか? Dim red,green,blue As Integer (red,green,blueの値は、他のコントロールから取得) PictureBox1.backcolor = RGB(red,green,blue) よろしくお願いします。

  • VBAで縦一列に数字を入力したい

    Private Sub CommandButton1_Click() Dim n As Integer Dim i As Integer Dim x As Integer For i = 1 To n x = i + 3 n = InputBox("層数の値を入力してください") Cells(3, 1).Value = ("基板") Cells(x, 1).Value = i x = x + 1 Next End Sub 上記のようなマクロを組んだのですが、4行目に1が入ってとまってしまいました。 これを完成させるにはどうしたらいいでしょうか?

  • Excel2000のVBAでわからないことがあります。

    こんなものを作ってみました。 Sub 理想体重() Dim Sin As Long Dim Tai As Long Sin = InputBox("あなたの体重は?", "体重") Tai = InputBox("あなたの身長は?", "身長") If Tai >= Sin * Sin * 21 / 10000 + 3 Then MsgBox "太りすぎです" ElseIf Tai <= Sin * Sin * 21 / 10000 - 3 Then MsgBox ("痩せすぎです") Else MsgBox ("標準です") End If End Sub 結果はきちんと出てくるのですが、最初の変数宣言のところがわかりません。 最初は、Longではなく、Integerにしたのですが、オーバーフローのエラーが出たので、Longに変更したところ、きちんと出てくるようになりました。 しかし、なぜ、Integerではだめなのかがわかりません。私としては、Integerは32,767までの数字が入るのだから、身長や体重を入れたぐらいだと、オーバーフローにはならないのではないかと考えています。 きっと、根本的なものがわかっていないんだとは思うのですが、違いを教えていただければうれしいです。 よろしくお願いいたします。 (VBAを勉強したばかりです。)

  • VBAに関して

    VBA超初心者の者ですが、ある一つのシートにいくつかの別のファイルを開いて順にコピーして貼り付けていくというプログラムを作成したいと思っています。 Sub naka() Dim k As Integer Dim r As String k = InputBox("ファイル数を記入してください") r = InputBox("範囲を指定してください") Call s1(k, r) End Sub Sub s1(i As Integer, rangearea As String) Dim v As Integer Dim x As String For v = 1 To i Dim OpenFileName As String With OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") ThisWorkbook.Sheets(1).Range("rangearea").Copy ActiveSheet.Range("1+(rangearea.rows.count*(v-1)),1").PasteSpecial End With Next v End Sub こんな感じでかいてみたものの全く異なったものをかいているようです。同じフォルダ内にコピーするファイルが存在しているものと仮定していますが、マイ ドキュメント内のファイルとしたいです。コピーすべきシートは1としています。大変分かりづらい文章ですが、おかしい部分の指摘、見本等示していただけたらありがたいです。

  • 階乗のマクロ

    階乗のマクロを作りたいのですが、全然できません。どこを変えたらいいのか教えて下さい。ちなみに今こうなっています。 ------------------------------------------------ Sub exam5() Dim intA As Integer Dim intB As Integer Dim intC As Integer intA = Application.InputBox("数値を入力してください。") intB = (intA - 1) intC = (intA) * (intB) MsgBox (intC) End Sub Function kaijou(intA As Integer, intB As Integer) As Integer kaijou = intA * intB End Function ------------------------------------------------ どうかお願いします。

  • マクロでセルの色を塗りたい

    マクロでセルの色を塗りたいです。 現在、予めRGBの値を取得しておいて Private Sub Worksheet_Change(ByVal Target As Range)   Dim R As Integer   Dim G As Integer   Dim B As Integer   R = 100   G = 50   B = 128   If Target.Value = "A" Then     Target.Interior.Color = RGB(R, G, B)   End If End Sub のように使っています。 このRGBの値を他の所で流用するに当たって、1つの変数のまとめたいのですが、 RGBをまとめて代入?する方法はあるでしょうか。 以下のような使い方をしたいです(勿論これはダメでしたけど。見るからにダメそうですし)。  Dim IRO As String  IRO = "100, 50, 128"  Target.Interior.Color = RGB(IRO) 不可能でしょうか?

  • 同じコマンドボタンからマウスカーソルがはなれたら

    フォーム上のコマンドボタンにマウスカーソルが触れたら色を付ける、 同じコマンドボタンからマウスカーソルがはなれたら 、また色を変える、 という動きをvbaで行いたいのですが、 Private Sub cmd_test_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.cmd_test.BackColor = RGB(255, 180, 200) End Sub で、マウスカーソルが触れたら色を付けることはできたのですが、 マウスカーソルがそのコマンドボタンから離れたら色を変えるという動きができません。 Private Sub cmd_test_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub Private Sub cmd_test_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub Private Sub cmd_test_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Me.cmd_test.BackColor = RGB(255, 255, 255) End Sub をしても、マウスカーソルが離れても色が白になりませんでした。

  • VBA

    ExcelのVBAについて質問です。 1000以下の任意の整数nを画面入力から読み込んで、1+2+3+4+・・・+nの合計値をセルA1に表示させたいのですが、1とnの和が足されてしまいます。 どこがおかしいのでしょうか? 指摘お願いします。 以下テキストです。 スペースなどは気にせずテキストの部分でご指摘お願いします Sub ()   Dim i As Integer Dim n As Integer n = Application.InputBox(Prompt:="1000以下の整数を入力してください", Type:=1) If n <= 1000 Then For i = 1 To n iResult = i + 1 Cells(1, 1) = iResult Next i End Sub よろしくおねがいします。

  • ワードで算用数字を漢数字に変換するマクロについて

    お世話になっております。 ・ワードで算用数字を漢数字に変換する方法又はマクロを探しています。 ・希望例: 22→二二、 100→一〇〇等 ・以下のマクロを実行しましたが、全く反応がありません。 (マクロについてはずぶの素人です) Option Explicit Sub KanToNum() Dim num As Integer, kan() As Variant kan() = Array("〇", "一", "二", "三", "四", "五", "六", "七", "八", "九") For num = 0 To 9 With ActiveDocument.Content.Find .Text = kan(num) .MatchByte = False .Replacement.Text = num .Execute Replace:=wdReplaceAll End With Next num End Sub マクロの修正を含めアドバイスをお願いします。 よろしくお願いします。

  • Excel VBA ・・・教えてください

    何度も質問させて頂いてます。すみません、 下記のプログラムはこの場で教えて頂いたプログラムで、 実行すると●の後を▲や■が追いかける動きをします。 下記のプログラムをある程度使用して 1~20の数字が順々で追いかけっこする プログラムを作成するにはどのようにすればいいのでしょうか… できればプログラムは長めにならず 20の数字から簡単に増やすことのできるような そんなプログラムが作成したいです… どなたかアドバイスお持ちの方 教えて下さいお願いします... Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim X1 As Integer, Y1 As Integer Dim X2 As Integer, Y2 As Integer Dim maru As String, yoko As String, tate As String Dim sankaku As String, shikaku As String Sub 描画() Cells(Y2, X2).Value = shikaku Cells(Y1, X1).Value = sankaku Cells(Y, X).Value = maru End Sub Sub 削除() Cells(Y2, X2).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() X2 = X1 Y2 = Y1 X1 = X Y1 = Y If yoko = "右" Then X = X + 1 Else X = X - 1 End If If X = 30 Then yoko = "左" ElseIf X = 1 Then yoko = "右" End If If tate = "上" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 20 Then tate = "下" ElseIf Y = 1 Then tate = "上" End If End Sub Sub main() maru = "●" sankaku = "▲" shikaku = "■" X = 1 Y = 1 X1 = 1 Y1 = 1 X2 = 1 Y2 = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

専門家に質問してみよう