●ワードパッド内の画像を、エクセルファイルに一括変換
'20150906_0700版
'【準備】
'1.ワードにて下記実施。
' <Word2003の場合>
'  ツール→マクロ→VisualBasicEditorをクリックし、
'  「MicrosoftVisualBasic for Applications」画面を表示させる。
' <Word2010の場合>
'  岾発」タブ→「VisualBasic」押下。
'   ※「開発」タブが出てない場合には、
'    ファイル→オプション→リボンのユーザ設定→右側の「リボンのユーザ設定」項目にて「メインタブ」にして、
'    「開発」項目にチェックを入れる。
' ◆MicrosoftVisualBasic for Applications」画面にて、
'   ツール→参照設定 押下し、
'  「参照設定」画面にて、下記のチェックをONにする。
'    ・Microsoft Excel xx.x Object Library
' 「MicrosoftVisualBasic for Applications」画面にて、
'   左上の「プロジェクト-Normal」ペインにて、下記をダブルクリック。
'    ・Normal -Microsoft Word Objects -This Document
' けβΕ撻ぅ鵑乏示された領域に、本内容をペーストし保存する。
'
'【利用方法】
'1.本マクロが書き込まれたワードファイルを開く。
'2.「1.」にてファイルを開いた状態にて、
'  エクセルへ貼り付けたい画像が含まれた、ワードパッドファイルを、ワードで開く。
'3.「2.」で開いたワード画面にて、下記実施。
' <Word2003の場合>
'  ツール→マクロ→マクロをクリック。
'    ・ワードorワードパッドファイル内画像をエクセルにエクスポート
' <Word2010の場合>
'  開発→マクロ をクリックし、
'  「マクロ」画面の、「マクロ」項目のドロップダウンリストにて下記を選択し、「実行」押下。
'    ・ワードorワードパッドファイル内画像をエクセルにエクスポート
'【エラーが出る場合】
'エラーが出た場合には、マクロを実行するPCにて、
'対象のワードパッドファイルを、マクロを実行するPCのワードパッドで一度開いて上書き保存後に、
'再度、対象のワードパッドファイルを、ワードで開いて、マクロを実行してみてください。

Sub ワードorワードパッドファイル内画像をエクセルにエクスポート()
 Dim myExcelApp As New Excel.Application
 Dim myActSheet As Worksheet
 Dim myWordRange As Word.Range
 Dim myActDoc As Document
 Dim myTargetCellGyou As Integer
 Dim myTargetCellRetu As Integer
 Dim myNPage As Integer
 Dim myStr As String

 Const numPageBreak As Integer = 2

 myExcelApp.Visible = True 'エクセルシートを表示。
 Set myActDoc = ActiveDocument
 Set myActSheet = myExcelApp.Workbooks.Add().ActiveSheet

 '方眼紙状に、セルサイズを修正。
 myActSheet.Cells.Select '全セルを選択状態にする。
 myExcelApp.Selection.ColumnWidth = 2 'セル幅を修正。
 myExcelApp.Selection.RowHeight = 12 'セル高さを修正。

 'エクセルにて表示倍率を75%にする。
 myExcelApp.ActiveWindow.Zoom = 75

 myTargetCellGyou = 2 'エクセルにて、ペーストを開始する行を指定。
 myTargetCellRetu = 0
 For Each myWordRange In myActDoc.Words
  If myWordRange.InlineShapes.Count > 0 Then 'ワード文章内に、図がある限り以下を実施。

   '改ページ設定。
   If myNPage > 1 And myNPage Mod numPageBreak = 0 Then
    myActSheet.HPageBreaks.Add myActSheet.Cells(myTargetCellGyou, 1)
    'myActSheet.VPageBreaks.Add myActSheet.Cells(myTargetCellGyou, 1)
   End If

   'myActSheet.Cells(myTargetCellGyou, 1) = str
   'str = ""
   'myTargetCellGyou = myTargetCellGyou + 2

   myWordRange.Copy 'ワードにて、開いた文書の1番目の表・図をコピーする

   myActSheet.Cells(myTargetCellGyou, 2).Select 'エクセルにて、x行、2列目セルを選択状態にする。

   'エクセルにて、ペーストする
   myActSheet.Paste
   'myActSheet.PasteSpecial , Link:=False, DisplayAsIcon:=False 'そのままペースト
   'myActSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, DisplayAsIcon:=False '拡張メタファイルでペースト。
   'myActSheet.PasteSpecial Format:="図 (BMP)", Link:=False, DisplayAsIcon:=False 'BMPでペースト。
   'myActSheet.PasteSpecial Format:="図 (PNG)", Link:=False, DisplayAsIcon:=False 'PNGでペースト。
   'myActSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False 'JPEGでペースト。
   'myActSheet.PasteSpecial Format:="図 (GIF)", Link:=False, DisplayAsIcon:=False 'GIFでペースト。

   myExcelApp.Selection.ShapeRange.ScaleHeight 1, msoTrue 'エクセルにて、画像の高さを1(=100%)に指定。

   ' ((選択状態の画像の高さ)÷(セル行の高さ)+0.9)の結果を、Fix関数で小数点以下切り捨て。
   '   例>画像の高さ11、セルの高さ5 の場合、11÷5+0.9=2.2+0.9=3.1 ⇒Fix関数で3。
   '◆.拭璽殴奪肇札觜埣佑法↓,涼佑魏短擦靴燭發里鯊綟。
   myTargetCellGyou = myTargetCellGyou + Fix((myExcelApp.Selection.Height / myActSheet.Rows(myTargetCellGyou).RowHeight + 0.9))
   'myTargetCellRetu = myTargetCellRetu + Fix((myExcelApp.Selection.Width / myActSheet.Rows(myTargetCellRetu).RowWidth + 0.9))

   '画像と画像の間に、2列分余白を開ける。
   myTargetCellGyou = myTargetCellGyou + 2

   '改ページ設定。
   myNPage = myNPage + 4

  Else
  If Asc(myWordRange.Text) <> 12 Then myStr = myStr & myWordRange.Text 'Word側改ページ無視
 End If
Next

'全ての処理を終えたら、A1セルを選択状態にする。
Cells(1, 1).Select

End Sub

コメントをかく


「http://」を含む投稿は禁止されています。

利用規約をご確認のうえご記入下さい

▼当HP内検索▼

▼メインメニュー▼



管理者用リンク
書籍(技術書)
・利用ソフト一覧
・Ethereal/Wireshark

転送速度




・powershell

・VBA










・Microsoft SQLserver








●CentOS6.9


▼動画サーバ関係

MP3について
DVDからのMP3変換について?
DVDからの動画変換について



▼自転車関係
・Panasonic CRAZY BOY

▼自動車関係
・SUZUKI エブリワゴンDA62W


▼Linux/Unix関係
・Linux基礎(パッケージ)
・Linux基礎(システム構成)
・Linux(Debian)基本コマンド
・Linuxコマンド(テキスト処理)
・Linuxコマンド(未整理)
・Linuxコマンド(ネットワーク系)
・FedoraCore OS メモ
・Debian Linux OS メモ
・Vine Linux OS メモ
・xPUD メモ

・CentOS6.4(minimal)


・solaris9 メモ
・solaris10 メモ

▼CCNA関係


▼ノートPC関連

液晶パネル

Fujitsu FMV-820MT
・Compaq Evo Notebook N110
・Panasonic Let's note CF-S51R
・Toshiba Dynabook Satellite 1800


▼デスクトップPC関連
・AOpen AX3S Pro-U
・ASUS CUSL2
・ASUS CUSL2-M


▼携帯電話
・NTT DoCoMo FOMA M1000
・FOMA P704iμ


▼モデム関連
▼ADSLモデム
・NTT ADSLモデム-NV
・NEC PA-WD605CV
・NEC PA-WD701CV
▼アナログモデム
・GVC F-1156IV/R9

▼ルータ関連
▼ルータ
・OMRON MR504DV
・FON La Fonera FON2100E
・Cisco Cisco2620
・Cisco4500M
・Cisco1601
  Cisco1603-R
  Cisco1605

・Cisco 共通メモ

・BUFFALO BLR3-TX4L
・I・O DATA NP-BBR
・NEC PA-WB7000/B (AtermWB7000H)
・マイクロ総研 NetGenesis OPT
・Persol PBR001

・YAMAHA NetVolante RTA54i
・FUJITSU NetVehicle-I

▼イーサネットコンバータ関連
・LINKSYS WET11

▼TA関連
・NEC AtermIT60D1L(S)

▼ハブ関連
・Cisco Catalyst 2924-XL-EN
・AlliedTelesis CentreCOM8216XL2
・BUFFALO LSW10/100-8
・corega FSW-5PM
・corega HUB-5PM
・CONTEC RT-1216S

▼NIC関連
・BUFFALO WLI-U2-SG54HP
・PLANEX GW-NS54GMX
・NTT-ME MN SS-LAN CARD 11 HQ

▼プリンタサーバ関連
・corega Pserver
・I・O DATA PLANT ET-FPS1E

▼デジカメ関連
・MINOLTA DiMAGE F100

▼携帯電話ケーブル関連
・BUFFALO IGM-UPDC
・OMRON ME64KTID
・OMRON ME96KTI
・SOURCENEXT SUS-USB-02 REV.1
・UP12 USB-PDC Converter
・DAISO D106

▼その他PC周辺機器
●キーボード
・Bluetoothキーボード BK3001BA
●ハンディターミナル
・ENSO BHT-6500
●ダウンスキャンコンバータ
・SC-TVEX
●CD-ROMドライブ
・NEC CD-2800D
・BUFFALO CDN-D24EX
・BUFFALO DVM-RDM16IU2
●MOドライブ
・ELECOM LMO-230-S
・FUJITSU MCF3064SS
・FUJITSU SMB-640WL2
●スピーカー
・Justy JSP-10W
●MP3プレーヤ
・SanDisk sansa e130
・NHJ V@mp VP-415
●インタフェースカード
・玄人志向 USB2.0+1394a-CB
・nbj IDE-3525
・Notebook Power Sharing
●ACアダプタ
・Universal AC Adaptor
●マウス
・Logitec Marble Mouse
・needs progres TN-30RFMOSG
●タブレット
・WACOM FAVO(ET-0405-U)
●その他
・IDEAL ME-320X(ME-320U2F)
・KY-05046S-12-H
・LifeView USB CapView
・ハードウェア(その他)
●シリアルレベルコンバータ
・シリアルレベルコンバータ


▼Windows系メモ
・DOS起動ディスク
・Microsoft OS メモ
・Microsoft 系ソフト メモ
・その他 ソフトウェアメモ
・Network Notepad
・Packet Tracerメモ
・パノラマ写真作成ソフト
・トラブル対処履歴


▼プログラミング関連
・言語比較
・VBS
・卒研事前メモ
・卒研メモ
・Windowsプログラミング
・JANコード・ISBNコード相互変換
●C言語
・文字列
・ファイル操作
●アルゴリズム
・再帰アルゴリズム
●JAVA
・Javaプログラミング
●その他
・初心者プログラミング
・ソフトウェア未整理メモ



▼家電関連
●テレビ
・SHARP AQUOS LC-20D10
・FUNAI TV-14CP
・BLUEDOT BTV-900K
・AKART AK-FTV913
・REAL LIFE JAPAN IQ-191LEDTV
AQUOS DZ3シリーズのDLNA機能
Viera V1シリーズのDLNA機能
●プロジェクタ
・crenova XPE470
●AVセレクタ
・DataSystem AVS430
●ビデオ
・FUNAI TV-14CP
●HDD&DVDレコーダ
・Toshiba RD-XS46
・NEC PK-AX10
●DVDプレーヤー
・GREEN HOUSER GH-PDV9AT
・情熱価格 DVDJ-DQ03
●メディアプレーヤー
・MINI HD MEDIA BOX 1080P
・1080P FULL HD Media Player
・1080P HD Media Player Mini 1080
・HD media player

●チューナー
・COMTEC DTW700
・HUMAX CI-S1

●アンテナ
・ADDZEST ZCP107
・マルハマ AGS-590

●ヘッドマウントディスプレイ
・VIRTUAL i/O i-glasses
●電動歯ブラシ
・ブラウン電動歯ブラシ
●電話機
・SHARP DA-C5-B
●コードレス電動ドリル、ドライバ
・BLACK&DECKER CSD300T
・RELIEF 30946?

▼カーナビ関係
Panasonic CN-GP510VD
Panasonic CN-G1100VD
▼カーステレオ関係
Kenwood U585SD

▼おもちゃ関連
●ラジコン
・ラジコンのプロポ改造


▼カー用品関連
●インダッシュTV
・ADDZEST TVS6250


▼DIY関連
・懸垂スタンド
・蓄光塗料


▼電子工作関係
・コネクタピンアサイン
・LANケーブルをAVケーブル化
・LANケーブルをRGBケーブル化
・地上デジタル放送アンテナ
・電子工作 メモ
・乾電池を充電


▼デザイン関連
●腕時計
・腕時計


▼その他

・HP製作関連メモ
・アイデアメモ

・コラム・メモ
・趣味・興味


・ToDo
・ネットインフラ?


▼資格・履歴書・マナー
・資格取得メモ
・工事担任者対策メモ
・履歴書・職務経歴書
・答辞


▼修学旅行 フランス(パリ)


▼掲示板
●掲示板
 意見・苦情・質問用に仮設置。

▼フリーエリア▼

▼おしらせ▼

管理人/副管理人のみ編集できます