【無料配信♪】Renta !全タテコミ作品第1話

ExcelVBAでテロップを表示したい。
ExcelVBAを独学でゼロから学んでる超初心者です。
worksheet上に右側から現れて左側に消えて行くというごくシンプルなテロップを作成したいのですが
ExcelVBAでテロップ作成することは出来ますか?
出来るのであれば、コードを教えて頂けるととてもありがたいです。
わがままな質問で申し訳ありません。宜しくお願い致します。

A 回答 (2件)

先の物では先頭部分の表示に問題があったので修正します。


それとともに表示時間を柔軟に調節出来るようにしました。
後の欠点としては、全角半角文字の区別をしていないので、表示にズレがでてしまう問題が残っています。


------------------------------------------------------------------------

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub sample2()

Dim i As Integer, j As Long, k As Integer
Dim tmp As String
Dim mes As String
Dim word As Integer
Dim loops As Integer
Dim CEL As String

mes = "ExcelVBAでテロップを表示したい。ExcelVBAを独学でゼロから学んでる超初心者です。" & _
"worksheet上に右側から現れて左側に消えて行くというごくシンプルなテロップを作成したいのですが" & _
"ExcelVBAでテロップ作成することは出来ますか?" & _
"出来るのであれば、コードを教えて頂けるととてもありがたいです。" & _
"わがままな質問で申し訳ありません。宜しくお願い致します。"

word = 30
loops = 3
CEL = "A1"
mes = String(word, " ") & mes

For k = 1 To loops
For i = 1 To Len(mes)
DoEvents
Sleep (250)
tmp = Mid(mes, i, word)
Range(CEL) = tmp
Next
Range(CEL).ClearContents
Next

End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
少し調整は必要みたいですけど、私的には全然問題なく使えます。
わがままな質問に付き合って頂き感謝致します。ありがとうございました。

お礼日時:2010/06/24 17:37

おもしろそうなので作って見ました。


本来はタイマーを使って表示のタイミングを調節した方が良かったのですが、安直にループ文を使ってタイミング調整をしているので、パソコンによって表示速度が変わるでしょう。
あえて解説はしませんので、ご自身でコードの探求を行ってください。



Sub sample()

Dim i As Integer, j As Long, k As Integer
Dim tmp As String
Dim mes As String
Dim word As Integer
Dim loops As Integer
Dim CEL As String

mes = "ExcelVBAでテロップを表示したい。ExcelVBAを独学でゼロから学んでる超初心者です。" & _
"worksheet上に右側から現れて左側に消えて行くというごくシンプルなテロップを作成したいのですが" & _
"ExcelVBAでテロップ作成することは出来ますか?" & _
"出来るのであれば、コードを教えて頂けるととてもありがたいです。" & _
"わがままな質問で申し訳ありません。宜しくお願い致します。"

word = 30
loops = 5
CEL = "A1"

For k = 1 To loops
For i = 1 To Len(mes)
For j = 0 To 5000000: Next
tmp = Mid(mes, i, word)
Range(CEL) = tmp
Next
Range(CEL).ClearContents
Next

End Sub

この回答への補足

ありがとうございます。表示速度調整は何とか出来そうです。
真に我がままをいって申し訳ありませんが、表示している間は他の作業が一切出来ない
のですが、解決方法はありますか。

補足日時:2010/06/24 15:26
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセルで動きのある文字を表示させる方法

エクセルで写真や文字を自動で動かして表示させる方法を教えて下さい。
以上

Aベストアンサー

エクセルは表計算ソフトで、パワポのように、プレゼンソフトではない。あまり無理を申されるな。
ーー
ワードにはアニメーション(書式ーフォントーアニメーション)画あるが、文字が動くとはいえない。
ーー
同様の質問
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q106984320
ーー
どうしてもというなら、VBAでタイマーを使って、短時間ごとに
ずらした状態を表示するぐらいか無いかもしれない。VBAを今から勉強するのなら簡単ではない。
APIなどの利用も必要かも。
http://homepage2.nifty.com/DreamyCat/APIpage1.htm
ーー
http://www.happy2-island.com/excelsmile/smile04/capter00205.shtml
ゲームの世界などでは、当たり前に見える画像は全てが動くわけだか、エクセルでは、ソフトを作る力点が違うのです。だからMSも力を入れてない、そういう設定を盛り込んでないと思います。
ーー
何かそれ専用のフリーソフトでも探すことです。
http://www.happy500z.com/YNxv9e9.html
ーー
初等HTML文のWEBページでも、marqeeは、できないブラウザもある。最低Javascriptなど使う。
ーー
お遊び
エクセルシートのA1に
「次ぎは東京行きです。」
と入れます。
VBEの標準モジュールに下記をコピペ。
Sub test02()
Cells(1, "A").Font.ColorIndex = 3
x = Cells(1, "A") & " "
For i = 1 To 1000
Call Wait(0.2)
x = Mid(x, 2, Len(x) - 1) & Mid(x, 1, 1)
Cells(1, "A") = x
Next i
End Sub
Sub Wait(tm As Single) 'tm秒間経過後に戻るサブルーチン
Dim ts
ts = Timer
Do While Timer < ts + tm
DoEvents
Loop
End Sub
実行すると、A1セルの文字が、左へ動くように見える。(マーキー)
駅の電光掲示板のイメージです。
止める仕組みもできてないボロですが、勉強して発展させてください。

エクセルは表計算ソフトで、パワポのように、プレゼンソフトではない。あまり無理を申されるな。
ーー
ワードにはアニメーション(書式ーフォントーアニメーション)画あるが、文字が動くとはいえない。
ーー
同様の質問
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q106984320
ーー
どうしてもというなら、VBAでタイマーを使って、短時間ごとに
ずらした状態を表示するぐらいか無いかもしれない。VBAを今から勉強するのなら簡単ではない。
APIなどの利用も必要かも。
http://ho...続きを読む

Qエクセルのセルに時計表示するには?

パソコンのシステム時計を使って、エクセルの1つのセルにリアルタイムに時刻を表示させる方法を教えてください。
システム時計でなくても、インターネットから標準時を取り込む方法でも良いと思います。
リアルタイムの時刻をエクセルのデータのひとつとして使いたいのです。
よろしくお願いします。

Aベストアンサー

追伸です。

# VRAMメモリのバッファの関係や仮想メモリの問題で、表示の問題は、PCの環境の問題ではないかと思います。

もう少し説明すると、Excelのワークシートに毎秒書き込むという作業そのものが負担なのです。こちらでは、その違いが分りませんが、ユーザーフォームではなく、例えば、ラベルやExcelのApplication.Caption を使うなどして、あまり、下位のRangeオブジェクトのプロパティにアクセスすることを避けるのがよいかもしれません。Rangeオブジェクトは、複合的な存在なのですね。

QExcelで文字の点滅方法

Excelでセル内の文字を点滅する方法を教えてください。
ヘルプや書籍で検索したのですが分かりませんでした。
できましたら、マクロを使わずにしたいのですが、無ければマクロでも可です。 宜しくお願いします。 使用しているVersionは"2000"です。

Aベストアンサー

Option Explicit

Private Sub Worksheet_Activate()
Const imax As Long = 5
Const tmax As Long = 10000000
Dim i As Long
Dim t As Long

For i = 0 To imax
Range("A1").Font.ColorIndex = 2

DoEvents

For t = 0 To tmax
Next t

Range("A1").Font.ColorIndex = 0

DoEvents

For t = 0 To tmax
Next t

Next i

End Sub

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qフォントの大きさ

Msg_box 関数 でメッセージを出力しているのですが
マーク(注意、警告 etc)を用いての表現の方法しかないのでしょうか?
 例えば メッセージのフォントのサイズを各々メッセージによって
     変えれないのでしょうか?
初歩的なご質問で申し訳御座いません
宜しくお願いします

Aベストアンサー

一応サンプルを作りました。
やってみて面白かったけど、やはりオリジナルを作ったほうがかなり楽だということを実感しました。

注意:
ここの掲示板は文字がずれるので、図形が壊れます。以下の文章をメモ帳などのテキストエディタにコピって読んでください。

・・・さて本題・・・


※メッセージボックスの構造
┏━━━━━━━━━━━━━━━━┓
┣━━━━━━━━━━━━━━━━┫
┃                ┃
┃ ┏━┓ ┏━━━━━━━━┓ ┃
┃ ┃I┃ ┃MSG_AREA┃ ┃
┃ ┗━┛ ┗━━━━━━━━┛ ┃
┃                ┃
┃   ┏━━┓  ┏━━┓   ┃
┃   ┃B1┃  ┃B2┃   ┃
┃   ┗━━┛  ┗━━┛   ┃
┗━━━━━━━━━━━━━━━━┛
[I]・・・アイコン(クラス名:Static)
[MSG_AREA]・・・メッセージ表示領域(クラス名:Static)
[B1/B2]・・・ボタン(クラス名:Button)
という構造になっています

メッセージボックスは指定のスタイルによりアイコンの有無・ボタンの数が変化します。
また、メッセージ文字数により、メッセージの表示領域が変更され、ダイアログのサイズも算出されます。
しかもこの大きさの計算は、ダイアログオブジェクトが創生される前に行われるため、フォントを指定したあと、独自で再配置をしなければなりません。この計算ロジックは非常にややこしいものです。


※VBのMsgBox関数(またはAPIMassegeBox関数)内部で行われていると思われる手順(フックしてSpyで調べました)
1.MSGの文字数/ボタンの数/アイコンの有無により、ダイアログの大きさの算出・各オブジェクトの配置位置の算出
2.ダイアログ本体を創生
3.ボタンをダイアログ内部に創生(複数のボタンが存在するとき、左側のボタンから創生)
4.アイコンがあるならアイコンを創生
5.メッセージを創生
6.ボタンにフォーカスをセット
7.画面に表示する(サンプルではここで操作しています)
という順序のようです。


サンプルは、画面に表示する直前にフォントを指定しています。上記で述べたとおり、各オブジェクトはすでにできあがってしまっているので、再配置が必要になります。(サンプル内のsetResize関数を作りこんでください)


以下を標準モジュールに貼り付けて、Sub Mainから実行するようにしてください。
[myMsgBox関数]がオリジナルMsgBoxを呼ぶための関数です。



Option Explicit

Public Const WH_CBT = 5

'太文字([400/700]にしているけど、フォントによって違うかも?)
Public Enum MY_BOLD
  MYB_FLASE = 400
  MYB_TRUE = 700
End Enum
'斜体
Public Enum MY_ITALIC
  MYI_FLASE = 0
  MYI_TRUE = 1
End Enum
'下線
Public Enum MY_UNDERLINE
  MYU_FLASE = 0
  MYU_TRUE = 1
End Enum
'取消し線
Public Enum MY_STRINKEOUT
  MYS_FLASE = 0
  MYS_TRUE = 1
End Enum


Public Const HCBT_ACTIVATE = 5 ' ウィンドウがこれからアクティブになる通知メッセージ

Public Const WM_SETFONT = &H30 'フォントを指定
Public Const WM_GETFONT = &H31 'テキストボックス、ラベル等が現在使っているフォントのハンドル

Public Const LF_FACESIZE = &H20
Public Const POINT_PER_INCH = 72
Public Const LOGPIXELSY = 90 '縦方向の1論理インチあたりのピクセル数

Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = (-1)
Public Const HWND_NOTOPMOST = (-2)
Public Const SWP_NOSIZE = &H1&
Public Const SWP_NOMOVE = &H2&
Public Const SWP_NOZORDER = &H4&
Public Const SWP_NOREDRAW = &H8&
Public Const SWP_NOACTIVATE = &H10&
Public Const SWP_FRAMECHANGED = &H20&
Public Const SWP_SHOWWINDOW = &H40&
Public Const SWP_HIDEWINDOW = &H80&
Public Const SWP_NOCOPYBITS = &H100&
Public Const SWP_NOOWNERZORDER = &H200&
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER


Public Type LOGFONT
 lfHeight     As Long 'キャラクタの高さ
 lfWidth      As Long 'キャラクタの幅(0 で標準的プロポーション)
 lfEscapement   As Long '相対的出力角度(単位:1/10度)
 lfOrientation   As Long '回転角度(単位:1/10度)
 lfWeight     As Long 'キャラクタの線幅(FW_BOLD, FW_NORMAL)
 lfItalic     As Byte 'イタリックの時 Chr$(1)、通常 Chr$(0)
 lfUnderline    As Byte 'アンダーライン付きの時 1
 lfStrikeOut    As Byte '横線付きの時 1
 lfCharSet     As Byte 'キャラクタセットの指定
 lfOutPrecision  As Byte '常に OUT_DEFAULT_PRECIS = 0
 lfClipPrecision  As Byte ' 同上
 lfQuality     As Byte 'DEFAULT_QUALITY, DRAFT_QUALITY, PROOF_QUALITY
 lfPitchAndFamily As Byte 'DEFAULT_PITCH,FIXED_PITCH, VAIABLE_PITCH
 lfFaceName    As String * LF_FACESIZE 'タイプフェース名
End Type

Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Any) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long


Private mHookProcWnd  As Long 'フックプロセスハンドル
Private mFontHandle   As Long '作成したフォントハンドル

Public Sub Main()
  Call myMsgBox("鈴木 宗○", vbOKCancel Or vbQuestion)
End Sub

'メッセージボックスの初期設定
Public Function myMsgBox( _
        inPrompt As String _
        , Optional inButtons As VbMsgBoxStyle = vbOKOnly _
        , Optional inTitle As String = "vs 辻本 清○" _
        , Optional inHelpFile _
        , Optional inContext _
        ) As VbMsgBoxResult
  'フック
  mHookProcWnd = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, App.hInstance, App.ThreadID)
  
  'メッセージボックスを呼ぶ
  myMsgBox = MsgBox(inPrompt, inButtons, inTitle, inHelpFile, inContext)
  
  'メッセージボックスで作成されたフォントを削除する
  Call delFont
End Function

'フック関数
Private Function MsgBoxHookProc _
    (ByVal nCode As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
  
  Static staFlg  As Boolean 'ワーキングフラグ
  
  'システムがウィンドウをアクティブ化しようとしている
  If nCode = HCBT_ACTIVATE Then
    If staFlg Then
      Exit Function
    End If
    staFlg = True
    
    'フォントを設定する
    Call setFont(wParam, 30, MYB_TRUE, MYI_TRUE, MYU_TRUE, MYS_TRUE)
    
    'オブジェクトのリサイズ
    Call setResize(wParam)
    
    Call UnhookWindowsHookEx(mHookProcWnd)
    staFlg = False
  End If
  ' フック関数の継続を中止
  MsgBoxHookProc = False
End Function

Private Sub setFont( _
    inOwnerWnd As Long, _
    Optional ByVal inFontSize As Single = -1, _
    Optional ByVal inBold As MY_BOLD = MYB_FLASE, _
    Optional ByVal inItalic As MY_ITALIC = MYI_FLASE, _
    Optional ByVal inUnderLine As MY_UNDERLINE = MYU_FLASE, _
    Optional ByVal inStrikeOut As MY_STRINKEOUT = MYS_FLASE _
    )

  Dim udtLOGFONT As LOGFONT
  Dim lngDC    As Long
  Dim lngWk    As Long
  Dim lngMsgWnd  As Long 'メッセージボックスのメッセージ部分のハンドル
  
  
  'すでに作成済みのフォントを削除
  Call delFont
  
  'メッセージボックスの中の、メッセージ部分のハンドルを得る
  lngMsgWnd = getWndMsg(inOwnerWnd)
  
  'デバイスコンテキストを得る
  lngDC = GetDC(lngMsgWnd)
  
  '現在のフォントのハンドルを取得
  lngWk = SendMessage(lngMsgWnd, WM_GETFONT, 0, 0&) And &HFFFF&
  
  ' フォント属性を取得
  Call GetObject(lngWk, Len(udtLOGFONT), udtLOGFONT)
  
  '新しい設定を行う
  With udtLOGFONT
    'フォントサイズ/太字/斜体/下線/取消し線
    If inFontSize > 0 Then
      .lfHeight = inFontSize * (GetDeviceCaps(GetDC(inOwnerWnd), LOGPIXELSY) / POINT_PER_INCH) * (udtLOGFONT.lfHeight / Abs(udtLOGFONT.lfHeight))
    End If
    .lfWeight = inBold
    .lfItalic = inItalic
    .lfUnderline = inUnderLine
    .lfStrikeOut = inStrikeOut
  End With
  
  '論理フォントの作成
  mFontHandle = CreateFontIndirect(udtLOGFONT)
  'DCへの関連付け
  Call SelectObject(lngDC, mFontHandle)
  'フォントを指定
  Call SendMessage(ByVal lngMsgWnd, ByVal WM_SETFONT, ByVal mFontHandle, 0&)

End Sub

'フォントオブジェクトの削除
Private Sub delFont()
  If mFontHandle <> 0& Then
    Call DeleteObject(mFontHandle)
    mFontHandle = 0
  End If
End Sub

'メッセージボックスの中の、メッセージ部分のハンドルを得る
Private Function getWndMsg(inWnd As Long) As Long
  Dim lngWnd1 As Long
  Dim lngWnd2 As Long
  
  'メッセージボックスには「Static」クラスを持つオブジェクトが1個か2個ある
  '1個の時は メッセージ
  '2個の時は 最初のStaticはアイコン/次にメッセージ
  
  lngWnd1 = FindWindowEx(inWnd, 0&, "Static" & vbNullChar, vbNullString)
  lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Static" & vbNullChar, vbNullString)
  
  '2個目が存在していたら2個目、そうじゃなけりゃ1個目のハンドルを返す
  getWndMsg = IIf(lngWnd2 <> 0&, lngWnd2, lngWnd1)
End Function

'オブジェクトのリサイズ
'(ここは作りこまないといけない。計算ロジック大変そう・・・・)
Private Function setResize(inWnd As Long)
  Dim lngWidth  As Long
  Dim lngHeight  As Long
  Dim lngWnd1   As Long
  Dim lngWnd2   As Long
  
  '本当はここで再配置ロジックを行う(ボタン/アイコン/メッセージ)の各ハンドルを得て、サイズを変更
  'ここに載っているのは、あくまでサンプルです
  'ボタン数が2個限定ですのでお間違いないように!!!!!!!!!!!!!!
  
  '画面サイズを取得
  lngWidth = (Screen.Width \ Screen.TwipsPerPixelX)
  lngHeight = (Screen.Height \ Screen.TwipsPerPixelY)
  
  'メッセージボックスを座標(0,0)へ表示/メッセージボックスを画面サイズに表示
  Call SetWindowPos(inWnd, 0, 0, 0, lngWidth, lngHeight, _
           SWP_NOZORDER Or SWP_NOACTIVATE)
  
  'メッセージ
  Call SetWindowPos(getWndMsg(inWnd), 0, 0, 0, lngWidth \ 2, lngHeight \ 2, _
           SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOMOVE)
          
  'ボタン1(大きさそのまま/配置変更)
  lngWnd1 = FindWindowEx(inWnd, 0&, "Button" & vbNullChar, vbNullString)
  Call SetWindowPos(lngWnd1, 0, 0, lngHeight - 50, 0, 0, _
           SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOSIZE)
  
  'ボタン2(大きさ変更/配置変更)
  lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Button" & vbNullChar, vbNullString)
  Call SetWindowPos(lngWnd2, 0, lngWidth - 400, lngHeight - 500, 300, 300, _
           SWP_NOZORDER Or SWP_NOACTIVATE)
End Function

一応サンプルを作りました。
やってみて面白かったけど、やはりオリジナルを作ったほうがかなり楽だということを実感しました。

注意:
ここの掲示板は文字がずれるので、図形が壊れます。以下の文章をメモ帳などのテキストエディタにコピって読んでください。

・・・さて本題・・・


※メッセージボックスの構造
┏━━━━━━━━━━━━━━━━┓
┣━━━━━━━━━━━━━━━━┫
┃                ┃
┃ ┏━┓ ┏━━━━━━━━┓ ┃
┃ ┃I┃ ┃MSG_AREA┃ ┃
┃ ┗━┛ ┗━━━━━━━━┛ ┃
┃         ...続きを読む

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

Qエクセル VBA ユーザーフォームを閉じる

ユーザーフォームを開く時は
UserForm1.Showですが
閉じる時は?
UserForm1.Close
だとコンパイルエラーになります。
End
にするしかないですか?

Aベストアンサー

Unload Me とか Unload UserForm1 でユーザーフォームを閉じることができます。

Qセルの値が変ると自動でマクロが実行される。

セルの値が変ると自動でマクロが実行されるVBAを教えて下さいm(_ _ )m
例えば、シート1のA1の値が変ると、マクロAが実行される。
シート1のA2の値が変ると、マクロBが実行される。
と一つのシート内に複数のイベントを設置したのですが、イマイチわかりません。
知恵をお貸し下さい。

Aベストアンサー

こんにちは
お邪魔します。

(1)まずはオーダー通りの基本型

Private Sub Worksheet_Change(ByVal Target As Range)
' ' 複数セルが変更された場合(単セルでない場合)は処理を抜ける
If Target.Count > 1 Then Exit Sub
' ' 変更されたセルが1列めでない場合は処理を抜ける
If Target.Column <> 1 Then Exit Sub
' ' 変更されたセルの行位置によって処理を分岐する
Select Case Target.Row
Case 1
' A1 の場合の処理
MsgBox "A1" ' 確認用(確認が済んだら当行削除)
Case 2
' A2 の場合の処理
MsgBox "A2" ' 確認用(確認が済んだら当行削除)
End Select
End Sub

(2)セルの位置によってもっと細かく分岐したい場合

Private Sub Worksheet_Change(ByVal Target As Range)
' ' 複数セルが変更された場合(単セルでない場合)は処理を抜ける
If Target.Count > 1 Then Exit Sub
' ' 変更されたセルの 列位置 によって処理を分岐する
Select Case Target.Column
Case 1 ' 1列めなら
' ' 変更されたセルの 行位置 によって処理を分岐する
Select Case Target.Row
Case 1 ' 1列め の 1行め なら
' A1 の場合の処理
MsgBox "A1" ' 確認用(確認が済んだら当行削除)
Case 2 ' 1列め の 2行め なら
' A2 の場合の処理
MsgBox "A2" ' 確認用(確認が済んだら当行削除)
End Select
Case 2 ' 2列めなら
' ' 変更されたセルの 行位置 によって処理を分岐する
Select Case Target.Row
Case 1 ' 2列め の 1行め なら
' B1 の場合の処理
MsgBox "B1" ' 確認用(確認が済んだら当行削除)
Case 2 ' 2列め の 2行め なら
' B2 の場合の処理
MsgBox "B2" ' 確認用(確認が済んだら当行削除)
End Select
End Select
End Sub

(3)セルのアドレスを採り文字列で分岐したい場合
   (個人的にはあまりお奨めしていませんが、知っておいた方が好いもの)

Private Sub Worksheet_Change(ByVal Target As Range)
'' ' 変更されたセルの 参照文字列(A1型) によって処理を分岐する
Select Case Target.Address(False, False)
Case "A1"
MsgBox "A1" ' 確認用(確認が済んだら当行削除)
Case "A2"
MsgBox "A2" ' 確認用(確認が済んだら当行削除)
Case "B1"
MsgBox "B1" ' 確認用(確認が済んだら当行削除)
Case "B2"
MsgBox "B2" ' 確認用(確認が済んだら当行削除)
End Select
End Sub

とりあえず、単セルの場合だけ、理解を深めてみましょう。
複数セルに値変更があった場合については、その後でいいと思います。
(1)にある
If Target.Count > 1 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
のような記述はイベントプロシージャでは多用される基本中の基本ですから
よーく咀嚼して呑み込んじゃってください。

一応、いわずもがなですが、
上に挙げたようなイベントプロシージャを複数併記することはできませんので
使わないものはコメントブロックして下さい。
VBE(Visual Basic Editor)のツールバーに[編集]というのを追加してあれば
[コメントブロック]、[非コメントブロック]というボタンがありますので適宜。

また、イベントプロシージャで注意するべき点として
例えば今回のChangeイベントの処理中にセルの値を変更すれば
再度Changeイベントが呼び出される(再帰)ということを知っておいてください。
その場合、
  Application.EnableEvents = False
  ' 処理
  Application.EnableEvents = True
のような形で、再帰を回避します。

私自身VBAを覚え初めの頃は、イベントプロシージャとばかり格闘して
日に何百回もエラーを出しながら納得がいくまで色んなことを試していた覚えがあります。
・オブジェクトやプロパティの基本的な扱い方
・条件分岐
などの基本事項を覚えるのには最適の課題ですから、頑張って挑戦し続けてください。

以上です。

///
Re:#2 ちょっと違うかも。
それは、「A1 と 同じ値 に変更された セル があった場合」の処理になっています。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") Then
MsgBox Target.Address
End If
End Sub
として、例えば、C3セルにA1と同じ値を設定すると違うのがわかると思います。
あしからず、、、

こんにちは
お邪魔します。

(1)まずはオーダー通りの基本型

Private Sub Worksheet_Change(ByVal Target As Range)
' ' 複数セルが変更された場合(単セルでない場合)は処理を抜ける
If Target.Count > 1 Then Exit Sub
' ' 変更されたセルが1列めでない場合は処理を抜ける
If Target.Column <> 1 Then Exit Sub
' ' 変更されたセルの行位置によって処理を分岐する
Select Case Target.Row
Case 1
' A1 の場合の処理
MsgBox "A1" ' 確認用(確認が済んだら当行削除)
...続きを読む

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

QエクセルVBA 指定のセル背景色を点滅させたい

お世話になります。
忘れやすい入力セル シート名“施設”の セルF3
(入力が必要なのは100回に1回くらいなので、やむを得ませんが)を気に留めさせるために、そのセルF3の背景色を例えば「薄い青」と「白」で交互に入れ替えればどうかと思いました。

ネットで検索すると、下記のQ&Aが参考になり、うまく当てはめられるものもありました。

しかし、下記ページのANo.#6様の方法がとても魅力的に思えたのですが、うまく出来ないのです。

私の至らない点を教えていただけるでしょうか?

私は、下記ページのコードをシートモジュールに貼りつけました。
しかし、それだけではセルの色は変わりません。

OSはWin2000PRO エクセル2002を使用しています。

http://virus.okwave.jp/kotaeru.php3?q=1499419&rev=1

入力忘れを防止するためが目的ですが、フォームに入力欄を設けたりはしたくないのです。(ほとんどの場合は省略できるので)

よろしく、お教えください。
お願いいたします。

お世話になります。
忘れやすい入力セル シート名“施設”の セルF3
(入力が必要なのは100回に1回くらいなので、やむを得ませんが)を気に留めさせるために、そのセルF3の背景色を例えば「薄い青」と「白」で交互に入れ替えればどうかと思いました。

ネットで検索すると、下記のQ&Aが参考になり、うまく当てはめられるものもありました。

しかし、下記ページのANo.#6様の方法がとても魅力的に思えたのですが、うまく出来ないのです。

私の至らない点を教えていただけるでしょうか?

私...続きを読む

Aベストアンサー

こういう方法はいかがでしょうか。

標準モジュールに以下を記述

Sub Blink()
 Const ColorIdx1 = 37
 Const ColorIdx2 = xlColorIndexNone
 With Worksheets("Sheet1").Range("A1").Interior
  If .ColorIndex = ColorIdx1 Then
   .ColorIndex = ColorIdx2
  Else
   .ColorIndex = ColorIdx1
  End If
 End With
 Application.OnTime Now + TimeValue("00:00:01"), "Blink"
End Sub

続いてThisWorkBookに以下を記述

Private Sub Workbook_Open()
 Blink
End Sub

これで保存していったんブックを閉じ、再び開いてみてください。Sheet1のA1セルが1秒間隔で点滅します。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング