いつもお世話になっています。
下記内容の変更をしたいのですが、自分ではうまくいかず、お力をお貸しください。
よろしくお願いします。
一枚のデータシートと一枚の入力用フォームがあります。
入力フォームのスピンボタンのＮＯをキーにして、データシートのレコードを一件ずつ切り替えて、表示させるようにしています。
さてデータシートのオートフィルターでフィルターをかけた時に、それにあわせて、スピンボタンのＮＯを飛ばすようにしたいのですが、どのように修正していいか、わかりません。
現状ですと、下記プロシージャですが、いまのままだと、スピンボタンの値が一つずつしかかわりません。
'スピンボタンの値が変わったらテキストボックスに反映
Private Sub SpinButton1_Change()
TextBox1.Value = SpinButton1.Value
Call hyouji
End Sub
Private Sub hyouji()
'データを検索して表示する
Dim fRange As Range
Dim fRow As Long
Set fRange = Sheets("data").Columns(3).Find(what:=TextBox1.Value, _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
If (fRange Is Nothing) Then '
MsgBox "Noがみつかりません", vbExclamation
Exit Sub
End If
fRow = fRange.Row '検索されたNoの行位置を求める
With Worksheets("data")
TextBox2.Value = .Cells(fRow, 4).Value
TextBox3.Value = .Cells(fRow, 5).Value
TextBox4.Value = .Cells(fRow, 6).Value
TextBox5.Value = .Cells(fRow, 7).Value
TextBox6.Value = .Cells(fRow, 8).Value
End With
SpinButton1.SetFocus
End Sub
※現物ファイルを下記に投稿（No5643）させていただきました。見ていただけると幸いです。
http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi
Sub Outlookが起動してないなら起動する()
Dim oApp 'As Outlook.Application OutlookのApplication オブジェクトを入れる
Dim myNameSpace 'As Outlook.NameSpac
Dim myFolder 'As Outlook.Folder
If Outlookが起動してるなら Then Exit Sub
'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を
Set oApp = CreateObject("Outlook.Application")
Set myNameSpace = oApp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー
myFolder.Display
'(通常サイズ olNormalWindow=2 , olMaximized=0,olMinimized=1)
oApp.ActiveWindow.WindowState = 0
End Sub
/////////////////////////////////////////////////////////////////
のような事がしたいのですが、
If Outlookが起動してるなら Then Exit Sub
をどうすればいいのか教えていただけませんか？
当方OFFICE２００７を使用しています。
いつもお世話になっています。
下記内容の変更をしたいのですが、自分ではうまくいかず、お力をお貸しください。
よろしくお願いします。
一枚のデータシートと一枚の入力用フォームがあります。
入力フォームのスピンボタンのＮＯをキーにして、データシートのレコードを一件ずつ切り替えて、表示させるようにしています。
さてデータシートのオートフィルターでフィルターをかけた時に、それにあわせて、スピンボタンのＮＯを飛ばすようにしたいのですが、どのように修正していいか、わかりません。
現状ですと、下記プロシージャですが、いまのままだと、スピンボタンの値が一つずつしかかわりません。
'スピンボタンの値が変わったらテキストボックスに反映
Private Sub SpinButton1_Change()
TextBox1.Value = SpinButton1.Value
Call hyouji
End Sub
Private Sub hyouji()
'データを検索して表示する
Dim fRange As Range
Dim fRow As Long
Set fRange = Sheets("data").Columns(3).Find(what:=TextBox1.Value, _
LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
If (fRange Is Nothing) Then '
MsgBox "Noがみつかりません", vbExclamation
Exit Sub
End If
fRow = fRange.Row '検索されたNoの行位置を求める
With Worksheets("data")
TextBox2.Value = .Cells(fRow, 4).Value
TextBox3.Value = .Cells(fRow, 5).Value
TextBox4.Value = .Cells(fRow, 6).Value
TextBox5.Value = .Cells(fRow, 7).Value
TextBox6.Value = .Cells(fRow, 8).Value
End With
SpinButton1.SetFocus
End Sub
※現物ファイルを下記に投稿（No5643）させていただきました。見ていただけると幸いです。
http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi
エクセルとアウトルックを立ち上げた状態でエクセルのシートにコマンドボタンを設置して、
*****************************************************
Private Sub CommandButton1_Click()
'参照設定：Microsoft Outlook ○.○ Object Library
Dim ObjOut As Outlook.Application
Dim OutMail As MailItem
Dim myNaSp As Namespace
Dim FolderName As String
Dim rc As Long
Set ObjOut = GetObject(, "OutLook.Application")
Set OutMail = ObjOut.CreateItem(olMailItem)
Set myNaSp = GetNamespace("MAPI")
FolderName = myNaSp.PickFolder
MsgBox "「" & FolderName & "」が選択されました。"
rc = Shell("C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE" & ActiveWorkbook.FullName, 1)
AppActivate rc
Set myNaSp = Nothing
End Sub
*****************************************************
をすると、アウトルックの「フォルダー選択」ダイアログが開くのですが、
フォルダを選択した後に、エクセル画面に戻りません。
手作業でエクセル画面に戻す（アクティブ）にするのですが
Shellの部分で、「ファイルが見つかりません」となります。
rc = Shell("C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE", 1)
に変更すると、エラーにはならないのですが、
新規のブックが立ち上がってしまいます。
エクセルのシートのボタンを押したら、アウトルックのフォルダ選択画面を出して
選択後、元のエクセルシートをアクティブにさせたいのですがどうすればいいでしょうか？
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
AppActivate xlApp
を追加してもダメでした。
ご教授よろしくお願いします。
シートの中の全てのハイパーリンクのアドレスとテキストを新シートに一覧で書き出すマクロを作ってるのですが、詰みました。
例えば、http://oshiete.goo.ne.jp/をctrl+A→ctrl+Cで、全体をコピーして
エクセルのシートに貼り付けます。（添付画像参照）
そうした状態で、
/////////////////////////////////////////////////////////
Sub test()
Dim h As Hyperlink
Dim MyRow As Long
Dim StrURL As String
Dim StrTEXT As String
Dim MyBook As Workbook
Dim NewBook As Workbook
Debug.Print ActiveSheet.Hyperlinks.Count
Set MyBook = ActiveWorkbook
Set NewBook = Workbooks.Add 'ブックを挿入したらアクティブになってしまう
MyRow = 1
For Each h In MyBook.ActiveSheet.Hyperlinks
StrURL = h.Address 'アドレスを抜き出す
If IsNull(h.TextToDisplay) = True Then
StrTEXT = ""
Else
StrTEXT = h.TextToDisplay '表示文字を抜き出す
End If
NewBook.Activate '新ブックをアクティブにする
Cells(MyRow, 1) = StrURL
Cells(MyRow, 2) = StrTEXT
MyRow = MyRow + 1
Next
Set MyBook = Nothing
Set NewBook = Nothing
End Sub
/////////////////////////////////////////////////////////
を実行してるのですが、h.TextToDisplayが空白の時？値がエラーの時？に、
実行時エラー ’-2147467259（800004005）':
'TextToDisplay'メソッドは失敗しました:'Hyperlink'オブジェクト
となってしまいます。
If IsNull(h.TextToDisplay) = True Then
をすれば回避できると思いましたが、ダメでした。
なんでこのエラーになるのかと、このエラーを回避する方法を教えてください。
ご回答よろしくお願いします。
excel2000のＶＢＡのプロシージャを教えてください。
写真にあるとおり、sheet1の Ａ１からＡ２００セルまでに、 フルパスのアドレス、０、空白 が入っています。
ここで、フルパスが入っているセルを 下記の条件でハイパーリンクに置きかえたい。
１．フルパスの入っているセルをハイパーリンクのセルに変更する。
２．ハイパーリンクは、ハイパーリンクでも、ハイパーリンク関数でもいい
３．そのフルパスをハイパーリンクのリンク先アドレスにする。
４．表示文字列を ★ としたいです。
また、０が入っているセルは、空白に変更させたい。
以上がやりたいことです。そして下記プロシージャでトライしてみましたがエラーとなりうまくいきません。
プロシージャの修正もしくは、最適なプロシージャがあれば教えて欲しいです。
よろしくお願いします。
Sub test()
Dim trange As Range
Dim i As Long
For i = 1 To 200
trange = ("A" & i)
If trange.Value = "" Or "0" Then
trange.Value = ""
Else
Worksheets("Sheet2").trange.Hyperlinks.Add anchor:="★", Address:=trange.Value
End If
Next i
End Sub
