--.--.-- (--)

スポンサーサイト 

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
EDIT |  --:-- |  スポンサー広告  | Top↑
2013.08.06 (Tue)

IEメモ 

Sub Main()
'IEを開く
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True

'画面へ移動する
ie.Navigate "http://www.forest.impress.co.jp/article/2013/05/excelvba/"
waitNavigation ie

'すべてのハイパーリンクのURLを取得
Dim a As Object
Dim urls As New Collection
For Each a In ie.Document.getElementsByTagName("A")
urls.Add a.href
Next

'すべてのページをチェック
Dim url As Variant
Dim i As Long
i = 1
For Each url In urls
'Webページを移動
ie.Navigate url
waitNavigation ie
'場所を書き出し
ActiveSheet.Cells(i, 1).Value = i
ActiveSheet.Cells(i, 2).Value = ie.Document.Title
ActiveSheet.Cells(i, 3).Value = ie.LocationURL
'翠田あいの存在をチェック
If InStr(ie.Document.body.innerHTML, "AiMidorita.png") > 0 Then
ActiveSheet.Cells(i, 4).Value = "○"
Else
ActiveSheet.Cells(i, 4).Value = "-"
End If
i = i + 1
Next

MsgBox "Stop"
ie.Visible = False
End Sub

'画面移動の完了待ち
Sub waitNavigation(ie As Object)
Do While ie.Busy Or ie.ReadyState < 4
DoEvents
Loop
End Sub
スポンサーサイト
EDIT |  00:05 |  Excel VBA  | TB(0)  | CM(0) | Top↑
2013.07.23 (Tue)

 

'thisworkbook####################################
Option Explicit
'当該ファイルを開いた時最初に実行
Private Sub Auto_Open()

End Sub
'Auto_Open実行後実行
Private Sub Workbook_Open()
Call mdlSave.ShortcutKey
End Sub

'mdSave###############################################
Option Explicit

Sub DefaultSetting()
Dim ActSheet As Object
Dim zoomValue As Integer

'初期値のセット
zoomValue = 100

Application.ScreenUpdating = False

'各シート毎に初期値を設定する。
For Each ActSheet In ActiveWorkbook.Worksheets
With ActiveWorkbook.Worksheets(ActSheet.Name)
.Select
.Cells(1, 1).Select
End With
Application.ActiveWindow.zoom = zoomValue
Next ActSheet

'終了処理
ActiveWorkbook.Worksheets(1).Select
Application.ScreenUpdating = True
End Sub

Sub FunctionSave()
Call DefaultSetting
ActiveWorkbook.Save
End Sub
'ショートカットキーの設定
Public Sub ShortcutKey()
'保存ショートカット[倍率100%][セルA1指定]
Application.OnKey "^s", "FunctionSave"
End Sub
EDIT |  02:13 |  Maple  | TB(0)  | CM(0) | Top↑
2013.07.23 (Tue)

iniファイルメモ 

' INIファイル文字列情報取得関数(API)の定義
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long

' INIファイルから文字列情報を取得する関数
' 返り値:取得データ
' 引き数:FName - .iniファイル名
' SName - セクション名
' KName - キー名
' Default - 取得に失敗したときや該当する項目が無かった時の戻り値
Public Function ReadIni(ByVal FName As String, ByVal SName As String, _
ByVal KName As String, ByVal Default As String) As String
Dim RtnCD As Long
Dim RtnStr As String

' GetPrivateProfileString APIを利用し、INIファイルから情報取得
RtnStr = Space$(256)
RtnCD = GetPrivateProfileString(SName, KName, Default, RtnStr, 255, _
FName)

' 戻り値設定
If RtnCD > 0 Then
If InStr(RtnStr, Chr$(0)) > 0 Then
ReadIni = Left$(RtnStr, InStr(RtnStr, Chr$(0)) - 1)
Else
ReadIni = ""
End If
Else
ReadIni = Default
End If

End Function

' INIファイルから取得した文字列情報を表示する関数
Public Sub ShowParaStr()
Const IniName = "C:\Users\Satoru\Desktop\Temple.ini"
Const SecName = "PERSONAL" ' セクション名
Const KeyName = "NAME" ' キー名
Const Default = "NONE" ' デフォルト値

MsgBox "キーの値は「" & _
ReadIni(IniName, SecName, KeyName, "") & _
"」です。"

End Sub
EDIT |  02:10 |  Excel VBA  | TB(0)  | CM(0) | Top↑
 | HOME |  NEXT

ブログ内検索

カレンダー

最近のコメント

リンク

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。